utils/arg_helper.cmx : \
utils/arg_helper.cmi
utils/arg_helper.cmi :
+utils/binutils.cmo : \
+ utils/binutils.cmi
+utils/binutils.cmx : \
+ utils/binutils.cmi
+utils/binutils.cmi :
utils/build_path_prefix_map.cmo : \
utils/build_path_prefix_map.cmi
utils/build_path_prefix_map.cmx : \
utils/int_replace_polymorphic_compare.cmi :
utils/load_path.cmo : \
utils/misc.cmi \
+ utils/local_store.cmi \
+ utils/config.cmi \
utils/load_path.cmi
utils/load_path.cmx : \
utils/misc.cmx \
+ utils/local_store.cmx \
+ utils/config.cmx \
utils/load_path.cmi
utils/load_path.cmi :
+utils/local_store.cmo : \
+ utils/local_store.cmi
+utils/local_store.cmx : \
+ utils/local_store.cmi
+utils/local_store.cmi :
utils/misc.cmo : \
utils/config.cmi \
utils/build_path_prefix_map.cmi \
typing/btype.cmo : \
typing/types.cmi \
typing/path.cmi \
+ utils/local_store.cmi \
typing/ident.cmi \
parsing/asttypes.cmi \
typing/btype.cmi
typing/btype.cmx : \
typing/types.cmx \
typing/path.cmx \
+ utils/local_store.cmx \
typing/ident.cmx \
parsing/asttypes.cmi \
typing/btype.cmi
utils/misc.cmi \
parsing/longident.cmi \
parsing/location.cmi \
+ utils/local_store.cmi \
typing/ident.cmi \
typing/env.cmi \
utils/clflags.cmi \
utils/misc.cmx \
parsing/longident.cmx \
parsing/location.cmx \
+ utils/local_store.cmx \
typing/ident.cmx \
typing/env.cmx \
utils/clflags.cmx \
utils/misc.cmi \
parsing/longident.cmi \
parsing/location.cmi \
+ utils/local_store.cmi \
utils/load_path.cmi \
typing/ident.cmi \
typing/datarepr.cmi \
utils/misc.cmx \
parsing/longident.cmx \
parsing/location.cmx \
+ utils/local_store.cmx \
utils/load_path.cmx \
typing/ident.cmx \
typing/datarepr.cmx \
typing/env.cmi
typing/ident.cmo : \
utils/misc.cmi \
+ utils/local_store.cmi \
utils/identifiable.cmi \
utils/clflags.cmi \
typing/ident.cmi
typing/ident.cmx : \
utils/misc.cmx \
+ utils/local_store.cmx \
utils/identifiable.cmx \
utils/clflags.cmx \
typing/ident.cmi
typing/subst.cmi \
typing/printpat.cmi \
typing/predef.cmi \
+ typing/patterns.cmi \
typing/path.cmi \
parsing/parsetree.cmi \
utils/misc.cmi \
typing/subst.cmx \
typing/printpat.cmx \
typing/predef.cmx \
+ typing/patterns.cmx \
typing/path.cmx \
parsing/parsetree.cmi \
utils/misc.cmx \
typing/path.cmi
typing/path.cmi : \
typing/ident.cmi
+typing/patterns.cmo : \
+ typing/types.cmi \
+ typing/typedtree.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/types.cmx \
+ typing/typedtree.cmx \
+ parsing/longident.cmx \
+ parsing/location.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/longident.cmi \
+ typing/ident.cmi \
+ parsing/asttypes.cmi
typing/persistent_env.cmo : \
utils/warnings.cmi \
utils/misc.cmi \
parsing/parsetree.cmi \
utils/misc.cmi \
parsing/location.cmi \
+ utils/local_store.cmi \
typing/ident.cmi \
utils/clflags.cmi \
typing/btype.cmi \
parsing/parsetree.cmi \
utils/misc.cmx \
parsing/location.cmx \
+ utils/local_store.cmx \
typing/ident.cmx \
utils/clflags.cmx \
typing/btype.cmx \
typing/path.cmi \
parsing/parsetree.cmi \
typing/oprint.cmi \
- utils/misc.cmi \
parsing/longident.cmi \
parsing/location.cmi \
typing/includeclass.cmi \
typing/path.cmx \
parsing/parsetree.cmi \
typing/oprint.cmx \
- utils/misc.cmx \
parsing/longident.cmx \
parsing/location.cmx \
typing/includeclass.cmx \
typing/btype.cmi \
parsing/asttypes.cmi \
parsing/ast_helper.cmi \
- typing/annot.cmi \
typing/typecore.cmi
typing/typecore.cmx : \
utils/warnings.cmx \
typing/btype.cmx \
parsing/asttypes.cmi \
parsing/ast_helper.cmx \
- typing/annot.cmi \
typing/typecore.cmi
typing/typecore.cmi : \
typing/types.cmi \
typing/ident.cmi \
typing/env.cmi \
typing/ctype.cmi \
- parsing/asttypes.cmi \
- typing/annot.cmi
+ parsing/asttypes.cmi
typing/typedecl.cmo : \
utils/warnings.cmi \
typing/typetexp.cmi \
typing/btype.cmi \
parsing/attr_helper.cmi \
parsing/asttypes.cmi \
- typing/annot.cmi \
typing/typemod.cmi
typing/typemod.cmx : \
utils/warnings.cmx \
typing/btype.cmx \
parsing/attr_helper.cmx \
parsing/asttypes.cmi \
- typing/annot.cmi \
typing/typemod.cmi
typing/typemod.cmi : \
typing/types.cmi \
bytecomp/dll.cmo : \
utils/misc.cmi \
utils/config.cmi \
+ utils/binutils.cmi \
bytecomp/dll.cmi
bytecomp/dll.cmx : \
utils/misc.cmx \
utils/config.cmx \
+ utils/binutils.cmx \
bytecomp/dll.cmi
bytecomp/dll.cmi :
bytecomp/emitcode.cmo : \
asmcomp/liveness.cmi \
asmcomp/linscan.cmi \
asmcomp/linearize.cmi \
+ file_formats/linear_format.cmi \
lambda/lambda.cmi \
asmcomp/interval.cmi \
asmcomp/interf.cmi \
asmcomp/liveness.cmx \
asmcomp/linscan.cmx \
asmcomp/linearize.cmx \
+ file_formats/linear_format.cmx \
lambda/lambda.cmx \
asmcomp/interval.cmx \
asmcomp/interf.cmx \
asmcomp/branch_relaxation_intf.cmo : \
asmcomp/linear.cmi \
lambda/debuginfo.cmi \
- asmcomp/cmm.cmi \
asmcomp/arch.cmo
asmcomp/branch_relaxation_intf.cmx : \
asmcomp/linear.cmx \
lambda/debuginfo.cmx \
- asmcomp/cmm.cmx \
asmcomp/arch.cmx
asmcomp/cmm.cmo : \
utils/targetint.cmi \
+ utils/misc.cmi \
lambda/lambda.cmi \
lambda/debuginfo.cmi \
middle_end/backend_var.cmi \
parsing/asttypes.cmi \
+ asmcomp/arch.cmo \
asmcomp/cmm.cmi
asmcomp/cmm.cmx : \
utils/targetint.cmx \
+ utils/misc.cmx \
lambda/lambda.cmx \
lambda/debuginfo.cmx \
middle_end/backend_var.cmx \
parsing/asttypes.cmi \
+ asmcomp/arch.cmx \
asmcomp/cmm.cmi
asmcomp/cmm.cmi : \
utils/targetint.cmi \
asmcomp/proc.cmi \
utils/numbers.cmi \
asmcomp/mach.cmi \
- utils/config.cmi \
asmcomp/cmm.cmi \
asmcomp/deadcode.cmi
asmcomp/deadcode.cmx : \
asmcomp/proc.cmx \
utils/numbers.cmx \
asmcomp/mach.cmx \
- utils/config.cmx \
asmcomp/cmm.cmx \
asmcomp/deadcode.cmi
asmcomp/deadcode.cmi : \
asmcomp/mach.cmi \
asmcomp/linear.cmi \
lambda/debuginfo.cmi \
- utils/config.cmi \
asmcomp/cmm.cmi \
asmcomp/linearize.cmi
asmcomp/linearize.cmx : \
asmcomp/mach.cmx \
asmcomp/linear.cmx \
lambda/debuginfo.cmx \
- utils/config.cmx \
asmcomp/cmm.cmx \
asmcomp/linearize.cmi
asmcomp/linearize.cmi : \
asmcomp/printmach.cmi \
utils/misc.cmi \
asmcomp/mach.cmi \
- utils/config.cmi \
asmcomp/cmm.cmi \
asmcomp/liveness.cmi
asmcomp/liveness.cmx : \
asmcomp/printmach.cmx \
utils/misc.cmx \
asmcomp/mach.cmx \
- utils/config.cmx \
asmcomp/cmm.cmx \
asmcomp/liveness.cmi
asmcomp/liveness.cmi : \
lambda/lambda.cmi \
asmcomp/interval.cmi \
lambda/debuginfo.cmi \
- utils/config.cmi \
asmcomp/cmm.cmi \
utils/clflags.cmi \
middle_end/backend_var.cmi \
lambda/lambda.cmx \
asmcomp/interval.cmx \
lambda/debuginfo.cmx \
- utils/config.cmx \
asmcomp/cmm.cmx \
utils/clflags.cmx \
middle_end/backend_var.cmx \
asmcomp/proc.cmi
asmcomp/proc.cmi : \
asmcomp/reg.cmi \
- asmcomp/mach.cmi
+ asmcomp/mach.cmi \
+ asmcomp/cmm.cmi
asmcomp/reg.cmo : \
asmcomp/cmm.cmi \
middle_end/backend_var.cmi \
asmcomp/scheduling.cmi : \
asmcomp/linear.cmi
asmcomp/selectgen.cmo : \
- lambda/simplif.cmi \
asmcomp/reg.cmi \
asmcomp/proc.cmi \
utils/numbers.cmi \
asmcomp/mach.cmi \
lambda/lambda.cmi \
lambda/debuginfo.cmi \
- utils/config.cmi \
asmcomp/cmm.cmi \
middle_end/backend_var.cmi \
parsing/asttypes.cmi \
asmcomp/arch.cmo \
asmcomp/selectgen.cmi
asmcomp/selectgen.cmx : \
- lambda/simplif.cmx \
asmcomp/reg.cmx \
asmcomp/proc.cmx \
utils/numbers.cmx \
asmcomp/mach.cmx \
lambda/lambda.cmx \
lambda/debuginfo.cmx \
- utils/config.cmx \
asmcomp/cmm.cmx \
middle_end/backend_var.cmx \
parsing/asttypes.cmi \
parsing/asttypes.cmi \
asmcomp/arch.cmo
asmcomp/selection.cmo : \
- asmcomp/spacetime_profiling.cmi \
asmcomp/selectgen.cmi \
asmcomp/proc.cmi \
asmcomp/mach.cmi \
- utils/config.cmi \
asmcomp/cmm.cmi \
utils/clflags.cmi \
asmcomp/arch.cmo \
asmcomp/selection.cmi
asmcomp/selection.cmx : \
- asmcomp/spacetime_profiling.cmx \
asmcomp/selectgen.cmx \
asmcomp/proc.cmx \
asmcomp/mach.cmx \
- utils/config.cmx \
asmcomp/cmm.cmx \
utils/clflags.cmx \
asmcomp/arch.cmx \
asmcomp/selection.cmi : \
asmcomp/mach.cmi \
asmcomp/cmm.cmi
-asmcomp/spacetime_profiling.cmo : \
- asmcomp/selectgen.cmi \
- asmcomp/proc.cmi \
- utils/misc.cmi \
- asmcomp/mach.cmi \
- lambda/lambda.cmi \
- lambda/debuginfo.cmi \
- utils/config.cmi \
- asmcomp/cmm.cmi \
- middle_end/backend_var.cmi \
- parsing/asttypes.cmi \
- asmcomp/arch.cmo \
- asmcomp/spacetime_profiling.cmi
-asmcomp/spacetime_profiling.cmx : \
- asmcomp/selectgen.cmx \
- asmcomp/proc.cmx \
- utils/misc.cmx \
- asmcomp/mach.cmx \
- lambda/lambda.cmx \
- lambda/debuginfo.cmx \
- utils/config.cmx \
- asmcomp/cmm.cmx \
- middle_end/backend_var.cmx \
- parsing/asttypes.cmi \
- asmcomp/arch.cmx \
- asmcomp/spacetime_profiling.cmi
-asmcomp/spacetime_profiling.cmi : \
- asmcomp/selectgen.cmi
asmcomp/spill.cmo : \
asmcomp/reg.cmi \
asmcomp/proc.cmi \
typing/ident.cmi \
typing/env.cmi \
lambda/debuginfo.cmi \
+ utils/clflags.cmi \
parsing/asttypes.cmi \
lambda/lambda.cmi
lambda/lambda.cmx : \
typing/ident.cmx \
typing/env.cmx \
lambda/debuginfo.cmx \
+ utils/clflags.cmx \
parsing/asttypes.cmi \
lambda/lambda.cmi
lambda/lambda.cmi : \
lambda/printlambda.cmi \
typing/primitive.cmi \
typing/predef.cmi \
+ typing/patterns.cmi \
typing/parmatch.cmi \
utils/misc.cmi \
parsing/longident.cmi \
lambda/printlambda.cmx \
typing/primitive.cmx \
typing/predef.cmx \
+ typing/patterns.cmx \
typing/parmatch.cmx \
utils/misc.cmx \
parsing/longident.cmx \
middle_end/clambda.cmi
file_formats/cmxs_format.cmi : \
utils/misc.cmi
+file_formats/linear_format.cmo : \
+ utils/misc.cmi \
+ parsing/location.cmi \
+ asmcomp/linear.cmi \
+ utils/config.cmi \
+ asmcomp/cmm.cmi \
+ file_formats/linear_format.cmi
+file_formats/linear_format.cmx : \
+ utils/misc.cmx \
+ parsing/location.cmx \
+ asmcomp/linear.cmx \
+ utils/config.cmx \
+ asmcomp/cmm.cmx \
+ file_formats/linear_format.cmi
+file_formats/linear_format.cmi : \
+ asmcomp/linear.cmi \
+ asmcomp/cmm.cmi
middle_end/closure/closure.cmo : \
utils/warnings.cmi \
lambda/switch.cmi \
utils/clflags.cmx \
utils/ccomp.cmx \
driver/compenv.cmi
-driver/compenv.cmi :
+driver/compenv.cmi : \
+ utils/clflags.cmi
driver/compile.cmo : \
lambda/translmod.cmi \
lambda/simplif.cmi \
typing/typedtree.cmi \
bytecomp/instruct.cmi \
typing/ident.cmi \
- driver/compile_common.cmi
+ driver/compile_common.cmi \
+ utils/clflags.cmi
driver/compile_common.cmo : \
utils/warnings.cmi \
typing/typemod.cmi \
driver/errors.cmi
driver/errors.cmi :
driver/main.cmo : \
+ driver/maindriver.cmi
+driver/main.cmx : \
+ driver/maindriver.cmx
+driver/main_args.cmo : \
+ utils/warnings.cmi \
+ utils/profile.cmi \
+ utils/misc.cmi \
+ utils/config.cmi \
+ driver/compenv.cmi \
+ utils/clflags.cmi \
+ driver/main_args.cmi
+driver/main_args.cmx : \
+ utils/warnings.cmx \
+ utils/profile.cmx \
+ utils/misc.cmx \
+ utils/config.cmx \
+ driver/compenv.cmx \
+ utils/clflags.cmx \
+ driver/main_args.cmi
+driver/main_args.cmi :
+driver/maindriver.cmo : \
utils/warnings.cmi \
utils/profile.cmi \
driver/makedepend.cmi \
bytecomp/bytepackager.cmi \
bytecomp/bytelink.cmi \
bytecomp/bytelibrarian.cmi \
- driver/main.cmi
-driver/main.cmx : \
+ driver/maindriver.cmi
+driver/maindriver.cmx : \
utils/warnings.cmx \
utils/profile.cmx \
driver/makedepend.cmx \
bytecomp/bytepackager.cmx \
bytecomp/bytelink.cmx \
bytecomp/bytelibrarian.cmx \
- driver/main.cmi
-driver/main.cmi :
-driver/main_args.cmo : \
- utils/warnings.cmi \
- utils/profile.cmi \
- utils/misc.cmi \
- utils/config.cmi \
- driver/compenv.cmi \
- utils/clflags.cmi \
- driver/main_args.cmi
-driver/main_args.cmx : \
- utils/warnings.cmx \
- utils/profile.cmx \
- utils/misc.cmx \
- utils/config.cmx \
- driver/compenv.cmx \
- utils/clflags.cmx \
- driver/main_args.cmi
-driver/main_args.cmi :
+ driver/maindriver.cmi
+driver/maindriver.cmi :
driver/makedepend.cmo : \
driver/pparse.cmi \
parsing/parsetree.cmi \
driver/optcompile.cmi : \
typing/typedtree.cmi \
driver/compile_common.cmi \
+ utils/clflags.cmi \
middle_end/backend_intf.cmi
driver/opterrors.cmo : \
parsing/location.cmi \
driver/opterrors.cmi
driver/opterrors.cmi :
driver/optmain.cmo : \
+ driver/optmaindriver.cmi
+driver/optmain.cmx : \
+ driver/optmaindriver.cmx
+driver/optmaindriver.cmo : \
utils/warnings.cmi \
utils/profile.cmi \
asmcomp/proc.cmi \
asmcomp/asmlink.cmi \
asmcomp/asmlibrarian.cmi \
asmcomp/arch.cmo \
- driver/optmain.cmi
-driver/optmain.cmx : \
+ driver/optmaindriver.cmi
+driver/optmaindriver.cmx : \
utils/warnings.cmx \
utils/profile.cmx \
asmcomp/proc.cmx \
asmcomp/asmlink.cmx \
asmcomp/asmlibrarian.cmx \
asmcomp/arch.cmx \
- driver/optmain.cmi
-driver/optmain.cmi :
+ driver/optmaindriver.cmi
+driver/optmaindriver.cmi :
driver/pparse.cmo : \
utils/warnings.cmi \
utils/profile.cmi \
typing/env.cmi \
typing/ctype.cmi \
utils/config.cmi \
+ driver/compenv.cmi \
utils/clflags.cmi \
asmcomp/asmlink.cmi \
toplevel/opttopdirs.cmi
typing/env.cmx \
typing/ctype.cmx \
utils/config.cmx \
+ driver/compenv.cmx \
utils/clflags.cmx \
asmcomp/asmlink.cmx \
toplevel/opttopdirs.cmi
driver/main_args.cmi \
parsing/location.cmi \
driver/compmisc.cmi \
+ driver/compenv.cmi \
utils/clflags.cmi \
toplevel/opttopmain.cmi
toplevel/opttopmain.cmx : \
driver/main_args.cmx \
parsing/location.cmx \
driver/compmisc.cmx \
+ driver/compenv.cmx \
utils/clflags.cmx \
toplevel/opttopmain.cmi
toplevel/opttopmain.cmi :
bytecomp/dll.cmi \
typing/ctype.cmi \
utils/config.cmi \
+ driver/compenv.cmi \
file_formats/cmo_format.cmi \
utils/clflags.cmi \
typing/btype.cmi \
bytecomp/dll.cmx \
typing/ctype.cmx \
utils/config.cmx \
+ driver/compenv.cmx \
file_formats/cmo_format.cmi \
utils/clflags.cmx \
typing/btype.cmx \
/boot/menhir/parser.ml* -diff
-# configure is declared as binary so that it doesn't get included in diffs.
-# This also means it will have the correct Unix line-endings, even on Windows.
-/configure binary
+# configure is a shell-script; the linguist-generated attribute suppresses
+# changes being displayed by default in pull requests.
+/configure text eol=lf -diff linguist-generated
# 'union' merge driver just unions textual content in case of conflict
# http://krlmlr.github.io/using-gitattributes-to-avoid-merge-conflicts/
*.adoc typo.long-line=may
+# Github templates and scripts lack headers, have long lines
+/.github/** typo.missing-header typo.long-line=may typo.very-long-line=may
+
/.mailmap typo.long-line typo.missing-header typo.non-ascii
/.merlin typo.missing-header
/Changes typo.utf8 typo.missing-header
-/News typo.utf8 typo.missing-header
+/release-info/News typo.utf8 typo.missing-header
/INSTALL typo.missing-header
/LICENSE typo.very-long-line typo.missing-header
# tools/ci/appveyor/appveyor_build.cmd only has missing-header because
# dra27 too lazy to update check-typo to interpret Cmd-style comments!
/tools/ci/appveyor/appveyor_build.cmd typo.very-long-line typo.missing-header typo.non-ascii
/tools/ci/appveyor/appveyor_build.sh typo.non-ascii
-/tools/ci/inria/remove-sinh-primitive.patch typo.white-at-eol typo.missing-header typo.long-line
-/tools/release-checklist typo.missing-header typo.very-long-line
-
+/tools/ci/inria/bootstrap/remove-sinh-primitive.patch typo.prune
+/release-info/howto.md typo.missing-header typo.long-line
+/release-info/templates/*.md typo.missing-header typo.very-long-line=may
# ignore auto-generated .depend files
.depend typo.prune
/.depend.menhir typo.prune
testsuite/tests/misc-unsafe/almabench.ml typo.long-line
testsuite/tests/tool-toplevel/strings.ml typo.utf8
testsuite/tests/win-unicode/*.ml typo.utf8
+testsuite/tests/asmgen/immediates.cmm typo.very-long-line
testsuite/tools/*.S typo.missing-header
testsuite/tools/*.asm typo.missing-header
testsuite/typing typo.missing-header
# Expect tests with overly long lines of expected output
testsuite/tests/parsing/docstrings.ml typo.very-long-line
+# The normalisation tests have very specific line endings which mustn't be
+# corrupted by git.
+testsuite/tests/tool-ocamltest/norm*.reference binary
+
tools/magic typo.missing-header
tools/eventlog_metadata.in typo.missing-header
--- /dev/null
+---
+name: Bug report
+about: Please submit bug reports here.
+title: ''
+labels: ''
+assignees: ''
+
+---
+<!--
+Welcome to OCaml's Issue tracker!
+
+OCaml's developers use this tracker for bugs and feature requests only, rather
+than user support.
+
+If you have questions about *using* OCaml, please ask at
+https://discuss.ocaml.org (more people read Discuss than this tracker, and
+you'll get confirmation of whether you've really found a bug or need a new
+feature).
+
+If your error came from the OCaml package manager, opam, (messages beginning
+`[ERROR] The compilation of ...`), please start at
+https://github.com/ocaml/opam-repository/issues/new.
+
+Some libraries and tools which used to be part of OCaml are now maintained
+separately. Please post questions about Graphics, Num, camlp4, LablTk, CamlDBM
+or OCamlTopWin on Discuss or on their respective issue trackers (see [README.adoc](https://github.com/ocaml/ocaml/blob/trunk/README.adoc#separately-maintained-components)
+for a full list).
+-->
--- /dev/null
+blank_issues_enabled: false
+contact_links:
+ - name: OCaml Discuss Forum
+ url: https://discuss.ocaml.org/
+ about: This is the best place to start with questions about using OCaml.
+ - name: opam Package Repository
+ url: https://github.com/ocaml/opam-repository/issues
+ about: >-
+ Virtually all OCaml packages are available in the opam repository - please
+ report packaging issues there.
--- /dev/null
+---
+name: Feature request
+about: Suggest a new feature for OCaml.
+title: ''
+labels: 'feature-wish'
+assignees: ''
+
+---
+<!--
+Welcome to OCaml's Issue tracker!
+
+We welcome all suggestions for improvements to OCaml. It is helpful if
+discussions on new features can initially begin on our community forums
+(see https://discuss.ocaml.org and https://ocaml.org/community), mainly because
+their readership is wider than this issue tracker, and you'll get better
+feedback as to whether your suggestion is a good idea or has been considered
+before. You may even end up with volunteers to help implement it!
+
+It is often easier to propose changes to the language than it is to design those
+changes: if you are proposing an alteration to the language, please be aware
+that we may need to have a more complete proposal of how the change will be
+implemented than "It would be nice to be able to X in OCaml" (see also
+https://github.com/ocaml/RFCs)
+-->
--- /dev/null
+name: main
+
+on: [push, pull_request]
+
+jobs:
+ no-naked-pointers:
+ runs-on: ubuntu-latest
+ steps:
+ - name: Checkout
+ uses: actions/checkout@v2
+ - name: configure tree
+ run: ./configure --disable-naked-pointers --disable-stdlib-manpages --disable-dependency-generation --enable-ocamltest
+ - name: Build
+ run: |
+ make -j world.opt
+ - name: Run the testsuite
+ run: |
+ make -C testsuite USE_RUNTIME=d all
+ i386-static:
+ runs-on: ubuntu-latest
+ steps:
+ - name: Checkout
+ uses: actions/checkout@v2
+ - name: Packages
+ run: |
+ sudo apt-get update -y && sudo apt-get install -y gcc-multilib gfortran-multilib
+ - name: configure tree
+ run: |
+ XARCH=i386 CONFIG_ARG='--disable-stdlib-manpages --disable-shared' bash -xe tools/ci/actions/runner.sh configure
+ - name: Build
+ run: |
+ bash -xe tools/ci/actions/runner.sh build
+ - name: Run the testsuite
+ run: |
+ bash -xe tools/ci/actions/runner.sh test
+ - name: Install
+ run: |
+ bash -xe tools/ci/actions/runner.sh install
+ - name: Other checks
+ run: |
+ bash -xe tools/ci/actions/runner.sh other-checks
+ full-flambda:
+ runs-on: ubuntu-latest
+ steps:
+ - name: Checkout
+ uses: actions/checkout@v2
+ - name: Packages
+ run: |
+ sudo apt-get update -y && sudo apt-get install -y texlive-latex-extra texlive-fonts-recommended
+ # Ensure that make distclean can be run from an empty tree
+ - name: distclean
+ run: |
+ MAKE_ARG=-j make distclean
+ - name: configure tree
+ run: |
+ MAKE_ARG=-j XARCH=x64 CONFIG_ARG='--enable-flambda --enable-dependency-generation' 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
+ - name: Run the testsuite
+ run: |
+ MAKE_ARG=-j OCAMLRUNPARAM=b,v=0 bash -xe tools/ci/actions/runner.sh test
+ - name: Build API Documentation
+ run: |
+ MAKE_ARG=-j OCAMLRUNPARAM=b,v=0 bash -xe tools/ci/actions/runner.sh api-docs
+ - name: Install
+ run: |
+ MAKE_ARG=-j OCAMLRUNPARAM=b,v=0 bash -xe tools/ci/actions/runner.sh install
+ - name: Other checks
+ run: |
+ MAKE_ARG=-j OCAMLRUNPARAM=b,v=0 bash -xe tools/ci/actions/runner.sh other-checks
--- /dev/null
+name: "Close stale issues"
+on:
+ schedule:
+ - cron: "15 4 * * 1,3,5"
+
+jobs:
+ stale:
+ runs-on: ubuntu-latest
+ steps:
+ - uses: actions/stale@v3
+ with:
+ repo-token: ${{ secrets.GITHUB_TOKEN }}
+ stale-issue-message: 'This issue has been open one year with no activity. Consequently, it is being marked with the "stale" label. What this means is that the issue will be automatically closed in 30 days unless more comments are added or the "stale" label is removed. Comments that provide new information on the issue are especially welcome: is it still reproducible? did it appear in other contexts? how critical is it? etc.'
+ days-before-stale: 366
+ days-before-close: 30
# local to root directory
-/Makefile.common
+/Makefile.build_config
/Makefile.config
/autom4te.cache
/ocamlc
/ocamldoc/test_latex
/ocamldoc/test
+/ocamltest/.dep
/ocamltest/ocamltest
/ocamltest/ocamltest.opt
/ocamltest/ocamltest_config.ml
+/ocamltest/ocamltest_unix.ml
/ocamltest/tsl_lexer.ml
/ocamltest/tsl_parser.ml
/ocamltest/tsl_parser.mli
/ocamltest/ocamltest.html
+/otherlibs/*/.dep
/otherlibs/dynlink/extract_crc
/otherlibs/dynlink/dynlink_platform_intf.mli
/otherlibs/dynlink/byte/dynlink.mli
/otherlibs/win32unix/time.c
/otherlibs/win32unix/unlink.c
/otherlibs/win32unix/fsync.c
+/otherlibs/win32unix/mkdir.c
/parsing/parser.ml
/parsing/parser.mli
/runtime/ocamlrund
/runtime/ocamlruni
/runtime/ld.conf
-/runtime/interp.a.lst
-/runtime/*.[sd]obj
/runtime/.gdb_history
-/runtime/*.d.c
-/runtime/*.pic.c
+/runtime/.dep
/runtime/domain_state32.inc
/runtime/domain_state64.inc
/tools/ocamldep
/tools/ocamldep.opt
-/tools/ocamldep.bak
/tools/ocamlprof
/tools/ocamlprof.opt
/tools/opnames.ml
/tools/ocamlobjinfo.opt
/tools/cvt_emit
/tools/cvt_emit.opt
-/tools/cvt_emit.bak
/tools/cvt_emit.ml
/tools/ocamlcp
/tools/ocamlcp.opt
/tools/ocamlmklib
/tools/ocamlmklib.opt
/tools/ocamlmklibconfig.ml
-/tools/objinfo_helper
-/tools/read_cmt
-/tools/read_cmt.opt
+/tools/ocamlcmt
+/tools/ocamlcmt.opt
/tools/cmpbyt
/tools/cmpbyt.opt
/tools/stripdebug
Joris Giovannangeli <joris@mantis>
Wilfred Hughes <wilfred@fb.com> <wilfred@mantis>
John Skaller <skaller@mantis>
+Eduardo Rafael <EduardoRFS@github>
# These contributors prefer to be referred to pseudonymously
whitequark <whitequark@whitequark.org>
#* *
#**************************************************************************
-dist: xenial
+dist: bionic
language: c
git:
submodules: false
script: tools/ci/travis/travis-ci.sh
matrix:
include:
- - env: CI_KIND=build XARCH=x64 CONFIG_ARG=--enable-flambda OCAMLRUNPARAM=b,v=0
- - env: CI_KIND=build XARCH=i386 CONFIG_ARG=--disable-stdlib-manpages
- addons:
- apt:
- packages:
- - gcc:i386
- - cpp:i386
- - binutils:i386
- - binutils-dev:i386
- - libx11-dev:i386
- - libc6-dev:i386
- - env: CI_KIND=build XARCH=x64
- addons:
- apt:
- packages:
- - texlive-latex-extra
- - texlive-fonts-recommended
- - env: CI_KIND=build XARCH=x64 CONFIG_ARG=--disable-shared
- - env: CI_KIND=build XARCH=x64 MIN_BUILD=1
+ - env: CI_KIND=check-depend
- env: CI_KIND=changes
- env: CI_KIND=manual
- env: CI_KIND=check-typo
-# - env: CI_KIND=tests
-# allow_failures:
-# - env: CI_KIND=tests
-addons:
- apt:
- packages:
- - binutils-dev
notifications:
email:
### User documentation
Changes affecting the compiler libraries should be reflected in the
-documentation comments of the relevant `.mli` files.
+documentation comments of the relevant `.mli` files. After running
+`make html_doc`, you can find the HTML Standard Library documentation
+at `./api_docgen/html/libref/index.html`.
-It is recommended to included changes to the OCaml Reference Manual
+It is recommended to include changes to the OCaml Reference Manual
(in particular for any change in the surface language), which is now
-part of the main repository (under `manual/`).
+part of the main repository (under `manual/`). To build the full manual,
+see the instructions in `manual/README.md`.
Finally, changes in command-line options should be integrated in the
manual, but also in the man pages present in the `man/` sub-directory
of the OCaml distribution.
+
### Changelog
Any user-visible change should have a `Changes` entry:
-OCaml 4.11 maintenance branch
------------------------------
+OCaml 4.12.0 (24 February 2021)
+-------------------------------
+### Supported platforms (highlights):
-OCaml 4.11.2 (24 February 2021)
--------------------------------
+- #9699: add support for iOS and macOS on ARM 64 bits
+ (Eduardo Rafael, review by Xavier Leroy, Nicolás Ojeda Bär
+ and Anil Madhavapeddy, additional testing by Michael Schmidt)
-### Build system:
+### Standard library (highlights):
-- #9938, #9939: Define __USE_MINGW_ANSI_STDIO=0 for the mingw-w64 ports to
- prevent their C99-compliant snprintf conflicting with ours.
- (David Allsopp, report by Michael Soegtrop, review by Xavier Leroy)
+- #9797: Add Sys.mkdir and Sys.rmdir.
+ (David Allsopp, review by Nicolás Ojeda Bär, Sébastien Hinderer and
+ Xavier Leroy)
+
+* #9765: add init functions to Bigarray.
+ (Jeremy Yallop, review by Gabriel Scherer, Nicolás Ojeda Bär, and
+ Xavier Leroy)
+
+* #9668: List.equal, List.compare
+ (This could break code using "open List" by shadowing
+ Stdlib.{equal,compare}.)
+ (Gabriel Scherer, review by Nicolás Ojeda Bär, Daniel Bünzli and Alain Frisch)
+
+- #9066: a new Either module with
+ type 'a Either.t = Left of 'a | Right of 'b
+ (Gabriel Scherer, review by Daniel Bünzli, Thomas Refis, Jeremy Yallop)
+
+- #9066: List.partition_map :
+ ('a -> ('b, 'c) Either.t) -> 'a list -> 'b list * 'c list
+ (Gabriel Scherer, review by Jeremy Yallop)
+
+- #9865: add Format.pp_print_seq
+ (Raphaël Proust, review by Nicolás Ojeda Bär)
+
+### Compiler user-interface and warnings (highlights):
+
+- #9657: Warnings can now be referred to by their mnemonic name. The names are
+ displayed using `-warn-help` and can be utilized anywhere where a warning list
+ specification is expected.
+ ocamlc -w +fragile-match
+ ...[@@ocaml.warning "-fragile-match"]
+ Note that only a single warning name at a time is supported for now:
+ "-w +foo-bar" does not work, you must use "-w +foo -w -bar".
+ (Nicolás Ojeda Bär, review by Gabriel Scherer, Florian Angeletti and
+ Leo White)
+
+- #8939: Command-line option to save Linear IR before emit.
+ (Greta Yorsh, review by Mark Shinwell, Sébastien Hinderer and Frédéric Bour)
+
+- #9003: Start compilation from Emit when the input file is in Linear IR format.
+ (Greta Yorsh, review by Jérémie Dimino, Gabriel Scherer and Frédéric Bour)
+
+### Language features (highlights):
+
+* #9500, #9727, #9866, #9870, #9873: Injectivity annotations
+ One can now mark type parameters as injective, which is useful for
+ abstract types:
+ module Vec : sig type !'a t end = struct type 'a t = 'a array end
+ On non-abstract types, this can be used to check the injectivity of
+ parameters. Since all parameters of record and sum types are by definition
+ injective, this only makes sense for type abbreviations:
+ type !'a t = 'a list
+ Note that this change required making the regularity check stricter.
+ (Jacques Garrigue, review by Jeremy Yallop and Leo White)
+
+### Runtime system (highlights):
+
+- #9534, #9947: Introduce a naked pointers checker mode to the runtime
+ (configure option --enable-naked-pointers-checker). Alarms are printed
+ when the garbage collector finds out-of-heap pointers that could
+ cause a crash in no-naked-pointers mode.
+ (Enguerrand Decorne, KC Sivaramakrishnan, Xavier Leroy, Stephen Dolan,
+ David Allsopp, Nicolás Ojeda Bär review by Xavier Leroy, Nicolás Ojeda Bär)
+
+* #1128, #7503, #9036, #9722, #10069: EINTR-based signal handling.
+ When a signal arrives, avoid running its OCaml handler in the middle
+ of a blocking section. Instead, allow control to return quickly to
+ a polling point where the signal handler can safely run, ensuring that
+ I/O locks are not held while it runs. A polling point was removed from
+ caml_leave_blocking_section, and one added to caml_raise.
+ (Stephen Dolan, review by Goswin von Brederlow, Xavier Leroy, Damien
+ Doligez, Anil Madhavapeddy, Guillaume Munch-Maccagnoni and Jacques-
+ Henri Jourdan)
+
+* #5154, #9569, #9734: Add `Val_none`, `Some_val`, `Is_none`, `Is_some`,
+ `caml_alloc_some`, and `Tag_some`. As these macros are sometimes defined by
+ authors of C bindings, this change may cause warnings/errors in case of
+ redefinition.
+ (Nicolás Ojeda Bär, review by Stephen Dolan, Gabriel Scherer, Mark Shinwell,
+ and Xavier Leroy)
+
+* #9674: Memprof: guarantee that an allocation callback is always run
+ in the same thread the allocation takes place
+ (Jacques-Henri Jourdan, review by Stephen Dolan)
+
+- #10025: Track custom blocks (e.g. Bigarray) with Memprof
+ (Stephen Dolan, review by Leo White, Gabriel Scherer and Jacques-Henri
+ Jourdan)
+
+- #9619: Change representation of function closures so that code pointers
+ can be easily distinguished from environment variables
+ (Xavier Leroy, review by Mark Shinwell and Damien Doligez)
+
+- #9654: More efficient management of code fragments.
+ (Xavier Leroy, review by Jacques-Henri Jourdan, Damien Doligez, and
+ Stephen Dolan)
+
+### Other libraries (highlights):
+
+- #9573: reimplement Unix.create_process and related functions without
+ Unix.fork, for better efficiency and compatibility with threads.
+ (Xavier Leroy, review by Gabriel Scherer and Anil Madhavapeddy)
+
+- #9575: Add Unix.is_inet6_addr
+ (Nicolás Ojeda Bär, review by Xavier Leroy)
+
+- #9930: new module Semaphore in the thread library, implementing
+ counting semaphores and binary semaphores
+ (Xavier Leroy, review by Daniel Bünzli and Damien Doligez,
+ additional suggestions by Stephen Dolan and Craig Ferguson)
+
+* #9206, #9419: update documentation of the threads library;
+ deprecate Thread.kill, Thread.wait_read, Thread.wait_write,
+ and the whole ThreadUnix module.
+ (Xavier Leroy, review by Florian Angeletti, Guillaume Munch-Maccagnoni,
+ and Gabriel Scherer)
+
+### Manual and documentation (highlights):
+
+- #9755: Manual: post-processing the html generated by ocamldoc and
+ hevea. Improvements on design and navigation, including a mobile
+ version, and a quick-search functionality for the API.
+ (San Vũ Ngọc, review by David Allsopp and Florian Angeletti)
+
+- #9468: HACKING.adoc: using dune to get merlin support
+ (Thomas Refis, review by Gabriel Scherer)
+
+- #9684: document in address_class.h the runtime value model in
+ naked-pointers and no-naked-pointers mode
+ (Xavier Leroy and Gabriel Scherer)
+
+### Internal/compiler-libs changes (highlights):
+
+- #9464, #9493, #9520, #9563, #9599, #9608, #9647: refactor
+ the pattern-matching compiler
+ (Thomas Refis and Gabriel Scherer, review by Florian Angeletti)
+
+- #9696: ocamltest now shows its log when a test fails. In addition, the log
+ contains the output of executed programs.
+ (Nicolás Ojeda Bär, review by David Allsopp, Sébastien Hinderer and Gabriel
+ Scherer)
+
+### Build system (highlights):
+
+- #9824, #9837: Honour the CFLAGS and CPPFLAGS variables.
+ (Sébastien Hinderer, review by David Allsopp)
+
+- #10063: (Re-)enable building on illumos (SmartOS, OmniOS, ...) and
+ Oracle Solaris; x86_64/GCC and 64-bit SPARC/Sun PRO C compilers.
+ (partially revert #2024).
+ (Tõivo Leedjärv and Konstantin Romanov,
+ review by Gabriel Scherer, Sébastien Hinderer and Xavier Leroy)
+
+
+### Language features:
+
+- #1655: pattern aliases do not ignore type constraints
+ (Thomas Refis, review by Jacques Garrigue and Gabriel Scherer)
+
+- #9429: Add unary operators containing `#` to the parser for use in ppx
+ rewriters
+ (Leo White, review by Damien Doligez)
### Runtime system:
+* #9697: Remove the Is_in_code_area macro and the registration of DLL code
+ areas in the page table, subsumed by the new code fragment management API
+ (Xavier Leroy, review by Jacques-Henri Jourdan)
+
+- #9756: garbage collector colors change
+ removes the gray color from the major gc
+ (Sadiq Jaffer and Stephen Dolan reviewed by Xavier Leroy,
+ KC Sivaramakrishnan, Damien Doligez and Jacques-Henri Jourdan)
+
+* #9513: Selectively initialise blocks in `Obj.new_block`. Reject `Custom_tag`
+ objects and zero-length `String_tag` objects.
+ (KC Sivaramakrishnan, review by David Allsopp, Xavier Leroy, Mark Shinwell
+ and Leo White)
+
+- #9564: Add a macro to construct out-of-heap block header.
+ (KC Sivaramakrishnan, review by Stephen Dolan, Gabriel Scherer,
+ and Xavier Leroy)
+
+- #9951: Ensure that the mark stack push optimisation handles naked pointers
+ (KC Sivaramakrishnan, reported by Enguerrand Decorne, review by Gabriel
+ Scherer, and Xavier Leroy)
+
+- #9678: Reimplement `Obj.reachable_words` using a hash table to
+ detect sharing, instead of temporary in-place modifications. This
+ is a prerequisite for Multicore OCaml.
+ (Xavier Leroy, review by Jacques-Henri Jourdan and Sébastien Hinderer)
+
+- #1795, #9543: modernize signal handling on Linux i386, PowerPC, and s390x,
+ adding support for Musl ppc64le along the way.
+ (Xavier Leroy and Anil Madhavapeddy, review by Stephen Dolan)
+
+- #9648, #9689: Update the generic hash function to take advantage
+ of the new representation for function closures
+ (Xavier Leroy, review by Stephen Dolan)
+
+- #9649: Update the marshaler (output_value) to take advantage
+ of the new representation for function closures
+ (Xavier Leroy, review by Damien Doligez)
+
+- #10050: update {PUSH,}OFFSETCLOSURE* bytecode instructions to match new
+ representation for closures
+ (Nathanaël Courant, review by Xavier Leroy)
+
+- #9728: Take advantage of the new closure representation to simplify the
+ compaction algorithm and remove its dependence on the page table
+ (Damien Doligez, review by Jacques-Henri Jourdan and Xavier Leroy)
+
+- #2195: Improve error message in bytecode stack trace printing and load
+ debug information during bytecode startup if OCAMLRUNPARAM=b=2.
+ (David Allsopp, review by Gabriel Scherer and Xavier Leroy)
+
+- #9466: Memprof: optimize random samples generation.
+ (Jacques-Henri Jourdan, review by Xavier Leroy and Stephen Dolan)
+
+- #9628: Memprof: disable sampling when memprof is suspended.
+ (Jacques-Henri Jourdan, review by Gabriel Scherer and Stephen Dolan)
+
- #10056: Memprof: ensure young_trigger is within the bounds of the minor
heap in caml_memprof_renew_minor_sample (regression from #8684)
(David Allsopp, review by Guillaume Munch-Maccagnoni and
Jacques-Henri Jourdan)
-- #9654: More efficient management of code fragments.
- (Xavier Leroy, review by Jacques-Henri Jourdan, Damien Doligez, and
- Stephen Dolan)
+- #9508: Remove support for FreeBSD prior to 4.0R, that required explicit
+ floating-point initialization to behave like IEEE standard
+ (Hannes Mehnert, review by David Allsopp)
-### Tools:
+- #8807, #9503: Use different symbols for do_local_roots on bytecode and native
+ (Stephen Dolan, review by David Allsopp and Xavier Leroy)
-- #9606, #9635, #9637: fix performance regression in the debugger
- (behaviors quadratic in the size of the debugged program)
- (Xavier Leroy, report by Jacques Garrigue and Virgile Prevosto,
- review by David Allsopp and Jacques-Henri Jourdan)
+- #9670: Report full major collections in Gc stats.
+ (Leo White, review by Gabriel Scherer)
+
+- #9675: Remove the caml_static_{alloc,free,resize} primitives, now unused.
+ (Xavier Leroy, review by Gabriel Scherer)
+
+- #9710: Drop "support" for an hypothetical JIT for OCaml bytecode
+ which has never existed.
+ (Jacques-Henri Jourdan, review by Xavier Leroy)
+
+- #9742, #9989: Ephemerons are now compatible with infix pointers occurring
+ when using mutually recursive functions.
+ (Jacques-Henri Jourdan, review by François Bobot)
+
+- #9888, #9890: Fixes a bug in the `riscv` backend where register t0 was not
+ saved/restored when performing a GC. This could potentially lead to a
+ segfault.
+ (Nicolás Ojeda Bär, report by Xavier Leroy, review by Xavier Leroy)
+
+- #9907: Fix native toplevel on native Windows.
+ (David Allsopp, review by Florian Angeletti)
+
+- #9909: Remove caml_code_area_start and caml_code_area_end globals (no longer
+ needed as the pagetable heads towards retirement).
+ (David Allsopp, review by Xavier Leroy)
+
+- #9949: Clarify documentation of GC message 0x1 and make sure it is
+ displayed every time a major cycle is forcibly finished.
+ (Damien Doligez, review by Xavier Leroy)
+
+- #10062: set ARCH_INT64_PRINTF_FORMAT correctly for both modes of mingw-w64
+ (David Allsopp, review by Xavier Leroy)
### Code generation and optimizations:
+- #9551: ocamlc no longer loads DLLs at link time to check that
+ external functions referenced from OCaml code are defined.
+ Instead, .so/.dll files are parsed directly by pure OCaml code.
+ (Nicolás Ojeda Bär, review by Daniel Bünzli, Gabriel Scherer,
+ Anil Madhavapeddy, and Xavier Leroy)
+
+- #9620: Limit the number of parameters for an uncurried or untupled
+ function. Functions with more parameters than that are left
+ partially curried or tupled.
+ (Xavier Leroy, review by Mark Shinwell)
+
+- #9752: Revised handling of calling conventions for external C functions.
+ Provide a more precise description of the types of unboxed arguments,
+ so that the ARM64 iOS/macOS calling conventions can be honored.
+ (Xavier Leroy, review by Mark Shinwell and Eduardo Rafael)
+
+- #9838: Ensure that Cmm immediates are generated as Cconst_int where
+ possible, improving instruction selection.
+ (Stephen Dolan, review by Leo White and Xavier Leroy)
+
+- #9864: Revised recognition of immediate arguments to integer operations.
+ Fixes several issues that could have led to producing assembly code
+ that is rejected by the assembler.
+ (Xavier Leroy, review by Stephen Dolan)
+
- #9969, #9981: Added mergeable flag to ELF sections containing mergeable
constants. Fixes compatibility with the integrated assembler in clang 11.0.0.
(Jacob Young, review by Nicolás Ojeda Bär)
+### Standard library:
+
+- #9781: add injectivity annotations to parameterized abstract types
+ (Jeremy Yallop, review by Nicolás Ojeda Bär)
+
+* #9554: add primitive __FUNCTION__ that returns the name of the current method
+ or function, including any enclosing module or class.
+ (Nicolás Ojeda Bär, Stephen Dolan, review by Stephen Dolan)
+
+- #9075: define to_rev_seq in Set and Map modules.
+ (Sébastien Briais, review by Gabriel Scherer and Nicolás Ojeda Bär)
+
+- #9561: Unbox Unix.gettimeofday and Unix.time
+ (Stephen Dolan, review by David Allsopp)
+
+- #9570: Provide an Atomic module with a trivial purely-sequential
+ implementation, to help write code that is compatible with Multicore
+ OCaml.
+ (Gabriel Scherer, review by Xavier Leroy)
+
+- #10035: Make sure that flambda respects atomicity in the Atomic module.
+ (Guillaume Munch-Maccagnoni, review by Gabriel Scherer)
+
+- #9571: Make at_exit and Printexc.register_printer thread-safe.
+ (Guillaume Munch-Maccagnoni, review by Gabriel Scherer and Xavier Leroy)
+
+- #9587: Arg: new Rest_all spec to get all rest arguments in a list
+ (this is similar to Rest, but makes it possible to detect when there
+ are no arguments (an empty list) after the rest marker)
+ (Gabriel Scherer, review by Nicolás Ojeda Bär and David Allsopp)
+
+- #9655: Obj: introduce type raw_data and functions raw_field, set_raw_field
+ to manipulate out-of-heap pointers in no-naked-pointer mode,
+ and more generally all other data that is not a well-formed OCaml value
+ (Xavier Leroy, review by Damien Doligez and Gabriel Scherer)
+
+- #9663: Extend Printexc API for raw backtrace entries.
+ (Stephen Dolan, review by Nicolás Ojeda Bär and Gabriel Scherer)
+
+- #9763: Add function Hashtbl.rebuild to convert from old hash table
+ formats (that may have been saved to persistent storage) to the
+ current hash table format. Remove leftover support for the hash
+ table format and generic hash function that were in use before OCaml 4.00.
+ (Xavier Leroy, review by Nicolás Ojeda Bär)
+
+- #10070: Fix Float.Array.blit when source and destination arrays coincide.
+ (Nicolás Ojeda Bär, review by Alain Frisch and Xavier Leroy)
+
+### Other libraries:
+
+- #8796: On Windows, make Unix.utimes use FILE_FLAG_BACKUP_SEMANTICS flag
+ to allow it to work with directories.
+ (Daniil Baturin, review by Damien Doligez)
+
+- #9593: Use new flag for non-elevated symbolic links and test for Developer
+ Mode on Windows
+ (Manuel Hornung, review by David Allsopp and Nicolás Ojeda Bär)
+
+* #9601: Return EPERM for EUNKNOWN -1314 in win32unix (principally affects
+ error handling when Unix.symlink is unavailable)
+ (David Allsopp, review by Xavier Leroy)
+
+- #9338, #9790: Dynlink: make sure *_units () functions report accurate
+ information before the first load.
+ (Daniel Bünzli, review by Xavier Leroy and Nicolás Ojeda Bär)
+
+* #9757, #9846, #10161: check proper ownership when operating over mutexes.
+ Now, unlocking a mutex held by another thread or not locked at all
+ reliably raises a Sys_error exception. Before, it was undefined
+ behavior, but the documentation did not say so.
+ Likewise, locking a mutex already locked by the current thread
+ reliably raises a Sys_error exception. Before, it could
+ deadlock or succeed (and do recursive locking), depending on the OS.
+ (Xavier Leroy, report by Guillaume Munch-Maccagnoni, review by
+ Guillaume Munch-Maccagnoni, David Allsopp, and Stephen Dolan)
+
+- #9802: Ensure signals are handled before Unix.kill returns
+ (Stephen Dolan, review by Jacques-Henri Jourdan)
+
+- #9869, #10073: Add Unix.SO_REUSEPORT
+ (Yishuai Li, review by Xavier Leroy, amended by David Allsopp)
+
+- #9906, #9914: Add Unix._exit as a way to exit the process immediately,
+ skipping any finalization action
+ (Ivan Gotovchits and Xavier Leroy, review by Sébastien Hinderer and
+ David Allsopp)
+
+- #9958: Raise exception in case of error in Unix.setsid.
+ (Nicolás Ojeda Bär, review by Stephen Dolan)
+
+- #9971, #9973: Make sure the process can terminate when the last thread
+ calls Thread.exit.
+ (Xavier Leroy, report by Jacques-Henri Jourdan, review by David Allsopp
+ and Jacques-Henri Jourdan).
+
+### Tools:
+
+- #9551: ocamlobjinfo is now able to display information on .cmxs shared
+ libraries natively; it no longer requires libbfd to do so
+ (Nicolás Ojeda Bär, review by Daniel Bünzli, Gabriel Scherer,
+ Anil Madhavapeddy, and Xavier Leroy)
+
+* #9299, #9795: ocamldep: do not process files during cli parsing. Fixes
+ various broken cli behaviours.
+ (Daniel Bünzli, review by Nicolás Ojeda Bär)
+
+### Debugging and profiling:
+
+- #9606, #9635, #9637: fix 4.10 performance regression in the debugger
+ (behaviors quadratic in the size of the debugged program)
+ (Xavier Leroy, report by Jacques Garrigue and Virgile Prevosto,
+ review by David Allsopp and Jacques-Henri Jourdan)
+
+- #9948: Remove Spacetime.
+ (Nicolás Ojeda Bär, review by Stephen Dolan and Xavier Leroy)
+
+### Manual and documentation:
+
+- #10142, #10154: improved rendering and latex code for toplevel code examples.
+ (Florian Angeletti, report by John Whitington, review by Gabriel Scherer)
+
+- #9745: Manual: Standard Library labeled and unlabeled documentation unified
+ (John Whitington, review by Nicolás Ojeda Bär, David Allsopp,
+ Thomas Refis, and Florian Angeletti)
+
+- #9877: manual, warn that multi-index indexing operators should be defined in
+ conjunction of single-index ones.
+ (Florian Angeletti, review by Hezekiah M. Carty, Gabriel Scherer,
+ and Marcello Seri)
+
+- #10233: Document `-save-ir-after scheduling` and update `-stop-after` options.
+ (Greta Yorsh, review by Gabriel Scherer and Florian Angeletti)
+
+### Compiler user-interface and warnings:
+
+- #1931: rely on levels to enforce principality in patterns
+ (Thomas Refis and Leo White, review by Jacques Garrigue)
+
+* #9011: Do not create .a/.lib files when creating a .cmxa with no modules.
+ macOS ar doesn't support creating empty .a files (#1094) and MSVC doesn't
+ permit .lib files to contain no objects. When linking with a .cmxa containing
+ no modules, it is now not an error for there to be no .a/.lib file.
+ (David Allsopp, review by Xavier Leroy)
+
+- #9560: Report partial application warnings on type errors in applications.
+ (Stephen Dolan, report and testcase by whitequark, review by Gabriel Scherer
+ and Thomas Refis)
+
+- #9583: when bytecode linking fails due to an unavailable module, the module
+ that requires it is now included in the error message.
+ (Nicolás Ojeda Bär, review by Vincent Laviron)
+
+- #9615: Attach package type attributes to core_type.
+ When parsing constraints on a first class module, attributes found after the
+ module type were parsed but ignored. Now they are attached to the
+ corresponding core_type.
+ (Etienne Millon, review by Thomas Refis)
+
+- #6633, #9673: Add hint when a module is used instead of a module type or
+ when a module type is used instead of a module or when a class type is used
+ instead of a class.
+ (Xavier Van de Woestyne, report by whitequark, review by Florian Angeletti
+ and Gabriel Scherer)
+
+- #9754: allow [@tailcall true] (equivalent to [@tailcall]) and
+ [@tailcall false] (warns if on a tailcall)
+ (Gabriel Scherer, review by Nicolás Ojeda Bär)
+
+- #9751: Add warning 68. Pattern-matching depending on mutable state
+ prevents the remaining arguments from being uncurried.
+ (Hugo Heuzard, review by Leo White)
+
+- #9783: Widen warning 16 (Unerasable optional argument) to more cases.
+ (Leo White, review by Florian Angeletti)
+
+- #10008: Improve error message for aliases to the current compilation unit.
+ (Leo White, review by Gabriel Scherer)
+
+- #10046: Link all DLLs with -static-libgcc on mingw32 to prevent dependency
+ on libgcc_s_sjlj-1.dll with mingw-w64 runtime 8.0.0 (previously this was
+ only needed for dllunix.dll).
+ (David Allsopp, report by Andreas Hauptmann, review by Xavier Leroy)
+
+- #9634: Allow initial and repeated commas in `OCAMLRUNPARAM`.
+ (Nicolás Ojeda Bär, review by Gabriel Scherer)
+
+### Internal/compiler-libs changes:
+
+- #8987: Make some locations more accurate
+ (Thomas Refis, review by Gabriel Scherer)
+
+- #9216: add Lambda.duplicate which refreshes bound identifiers
+ (Gabriel Scherer, review by Pierre Chambart and Vincent Laviron)
+
+- #9376: Remove spurious Ptop_defs from #use
+ (Leo White, review by Damien Doligez)
+
+- #9604: refactoring of the ocamltest codebase.
+ (Nicolás Ojeda Bär, review by Gabriel Scherer and Sébastien Hinderer)
+
+- #9498, #9511: make the pattern-matching analyzer more robust to
+ or-pattern explosion, by stopping after the first counter-example to
+ exhaustivity
+ (Gabriel Scherer, review by Luc Maranget, Thomas Refis and Florian Angeletti,
+ report by Alex Fedoseev through Hongbo Zhang)
+
+- #9514: optimize pattern-matching exhaustivity analysis in the single-row case
+ (Gabriel Scherer, review by Stephen DOlan)
+
+- #9442: refactor the implementation of the [@tailcall] attribute
+ to allow for a structured attribute payload
+ (Gabriel Scherer, review by Vladimir Keleshev and Nicolás Ojeda Bär)
+
+- #9688: Expose the main entrypoint in compilerlibs
+ (Stephen Dolan, review by Nicolás Ojeda Bär, Greta Yorsh and David Allsopp)
+
+- #9715: recheck scope escapes after normalising paths
+ (Matthew Ryan, review by Gabriel Scherer and Thomas Refis)
+
+- #9778: Fix printing for bindings where polymorphic type annotations and
+ attributes are present.
+ (Matthew Ryan, review by Nicolás Ojeda Bär)
+
+- #9797, #9849: Eliminate the routine use of external commands in ocamltest.
+ ocamltest no longer calls the mkdir, rm and ln external commands (at present,
+ the only external command ocamltest uses is diff).
+ (David Allsopp, review by Nicolás Ojeda Bär, Sébastien Hinderer and
+ Xavier Leroy)
+
+- #9801: Don't ignore EOL-at-EOF differences in ocamltest.
+ (David Allsopp, review by Damien Doligez, much input and thought from
+ Daniel Bünzli, Damien Doligez, Sébastien Hinderer, and Xavier Leroy)
+
+- #9889: more caching when printing types with -short-path.
+ (Florian Angeletti, review by Gabriel Scherer)
+
+- #9591: fix pprint of polyvariants that start with a core_type, closed,
+ not low (Chet Murthy, review by Florian Angeletti)
+
+- #9590: fix pprint of extension constructors (and exceptions) that rebind
+ (Chet Murthy, review by octachron@)
+
+- #9963: Centralized tracking of frontend's global state
+ (Frédéric Bour and Thomas Refis, review by Gabriel Scherer)
+
+- #9631: Named text sections for caml_system__code_begin/end symbols
+ (Greta Yorsh, review by Frédéric Bour)
+
+- #9896: Share the strings representing scopes, fixing some regression
+ on .cmo/.cma sizes
+ (Alain Frisch and Xavier Clerc, review by Gabriel Scherer)
+
+### Build system:
+
+- #9332, #9518, #9529: Cease storing C dependencies in the codebase. C
+ dependencies are generated on-the-fly in development mode. For incremental
+ compilation, the MSVC ports require GCC to be present.
+ (David Allsopp, review by Sébastien Hinderer, YAML-fu by Stephen Dolan)
+
+- #7121, #9558: Always have the autoconf-discovered ld in PACKLD, with
+ extra flags in new variable PACKLD_FLAGS. For
+ cross-compilation, this means the triplet-prefixed version will always be
+ used.
+ (David Allsopp, report by Adrian Nader, review by Sébastien Hinderer)
+
+- #9527: stop including configuration when running 'clean' rules
+ to avoid C dependency recomputation.
+ (Gabriel Scherer, review by David Allsopp)
+
+- #9804: Build C stubs of libraries in otherlibs/ with debug info.
+ (Stephen Dolan, review by Sébastien Hinderer and David Allsopp)
+
+- #9938, #9939: Define __USE_MINGW_ANSI_STDIO=0 for the mingw-w64 ports to
+ prevent their C99-compliant snprintf conflicting with ours.
+ (David Allsopp, report by Michael Soegtrop, review by Xavier Leroy)
+
+- #9895, #9523: Avoid conflict with C++20 by not installing VERSION to the OCaml
+ Standard Library directory.
+ (Bernhard Schommer, review by David Allsopp)
+
+- #10044: Always report the detected ARCH, MODEL and SYSTEM, even for bytecode-
+ only builds (fixes a "configuration regression" from 4.08 for the Windows
+ builds)
+ (David Allsopp, review by Xavier Leroy)
+
+- #10071: Fix bug in tests/misc/weaklifetime.ml that was reported in #10055
+ (Damien Doligez and Gabriel Scherer, report by David Allsopp)
+
### Bug fixes:
+- #7538, #9669: Check for misplaced attributes on module aliases
+ (Leo White, report by Thomas Leonard, review by Florian Angeletti)
+
+- #7813, #9955: make sure the major GC cycle doesn't get stuck in Idle state
+ (Damien Doligez, report by Anders Fugmann, review by Jacques-Henri Jourdan)
+
+- #7902, #9556: Type-checker infers recursive type, even though -rectypes is
+ off.
+ (Jacques Garrigue, report by Francois Pottier, review by Leo White)
+
+- #8746: Hashtbl: Restore ongoing traversal status after filter_map_inplace
+ (Mehdi Bouaziz, review by Alain Frisch)
+
+- #8747, #9709: incorrect principality warning on functional updates of records
+ (Jacques Garrigue, report and review by Thomas Refis)
+
+* #8907, #9878: `Typemod.normalize_signature` uses wrong environment
+ (Jacques Garrigue, report and review by Leo White)
+
+- #9421, #9427: fix printing of (::) in ocamldoc
+ (Florian Angeletti, report by Yawar Amin, review by Damien Doligez)
+
+- #9440: for a type extension constructor with parameterised arguments,
+ REPL displayed <poly> for each as opposed to the concrete values used.
+ (Christian Quinn, review by Gabriel Scherer)
+
+- #9433: Fix package constraints for module aliases
+ (Leo White, review by Jacques Garrigue)
+
+- #9469: Better backtraces for lazy values
+ (Leo White, review by Nicolás Ojeda Bär)
+
+- #9521, #9522: correctly fail when comparing functions
+ with Closure and Infix tags.
+ (Gabriel Scherer and Jeremy Yallop and Xavier Leroy,
+ report by Twitter user @st_toHKR through Jun Furuse)
+
+- #9611: maintain order of load path entries in various situations: when passing
+ them to system linker, ppx contexts, etc.
+ (Nicolás Ojeda Bär, review by Jérémie Dimino and Gabriel Scherer)
+
+- #9633: ocamltest: fix a bug when certain variables set in test scripts would
+ be ignored (eg `ocamlrunparam`).
+ (Nicolás Ojeda Bär, review by Sébastien Hinderer)
+
+- #9681, #9690, #9693: small runtime changes
+ for the new closure representation (#9619)
+ (Xavier Leroy, Sadiq Jaffer, Gabriel Scherer,
+ review by Xavier Leroy and Jacques-Henri Jourdan)
+
+- #9739, #9747: Avoid calling type variables, types that are not variables in
+ recursive occurrence error messages
+ (for instance, "Type variable int occurs inside int list")
+ (Florian Angeletti, report by Stephen Dolan, review by Armaël Guéneau)
+
+- #9759, #9767: Spurious GADT ambiguity without -principal
+ (Jacques Garrigue, report by Thomas Refis,
+ review by Thomas Refis and Gabriel Scherer)
+
+- #9799, #9803: make pat_env point to the correct environment
+ (Thomas Refis, report by Alex Fedoseev, review by Gabriel Scherer)
+
+- #9825, #9830: the C global variable caml_fl_merge and the C function
+ caml_spacetime_my_profinfo (bytecode version) were declared and
+ defined with different types. This is undefined behavior and
+ cancause link-time errors with link-time optimization (LTO).
+ (Xavier Leroy, report by Richard Jones, review by Nicolás Ojeda Bär)
+
+- #9753: fix build for Android
+ (Eduardo Rafael, review by Xavier Leroy)
+
+- #9848, #9855: Fix double free of bytecode in toplevel
+ (Stephen Dolan, report by Sampsa Kiiskinen, review by Gabriel Scherer)
+
+- #9858, #9861: Compiler fails with Ctype.Nondep_cannot_erase exception
+ (Thomas Refis, report by Philippe Veber, review by Florian Angeletti)
+
+- #9860: wrong range constraint for subtract immediate on zSystems / s390x
+ (Xavier Leroy, review by Stephen Dolan)
+
+- #9868, #9872, #9892: bugs in {in,out}_channel_length and seek_in
+ for files opened in text mode under Windows
+ (Xavier Leroy, report by Alain Frisch, review by Nicolás Ojeda Bär
+ and Alain Frisch)
+
+- #9925: Correct passing -fdebug-prefix-map to flexlink on Cygwin by prefixing
+ it with -link.
+ (David Allsopp, review by Xavier Leroy)
+
+- #9927: Restore Cygwin64 support.
+ (David Allsopp, review by Xavier Leroy)
+
+- #9940: Fix unboxing of allocated constants from other compilation units
+ (Vincent Laviron, report by Stephen Dolan, review by Xavier Leroy and
+ Stephen Dolan)
+
+- #9991: Fix reproducibility for `-no-alias-deps`
+ (Leo White, review by Gabriel Scherer and Florian Angeletti)
+
+- #9998: Use Sys.opaque_identity in CamlinternalLazy.force
+ This removes extra warning 59 messages when compiling afl-instrumented
+ code with flambda -O3.
+ (Vincent Laviron, report by Louis Gesbert, review by Gabriel Scherer and
+ Pierre Chambart)
+
+- #9999: fix -dsource printing of the pattern (`A as x | (`B as x)).
+ (Gabriel Scherer, report by Anton Bachin, review by Florian Angeletti)
+
- #9970, #10010: fix the declaration scope of extensible-datatype constructors.
A regression that dates back to 4.08 makes extensible-datatype constructors
with inline records very fragile, for example:
(Gabriel Scherer, review by Thomas Refis and Leo White,
report by Nicolás Ojeda Bär)
+- #10048: Fix bug with generalized local opens.
+ (Leo White, review by Thomas Refis)
+
+- #10106, #10112: some expected-type explanations where forgotten
+ after some let-bindings
+ (Gabriel Scherer, review by Thomas Refis and Florian Angeletti,
+ report by Daniil Baturin)
+
+OCaml 4.11 maintenance branch
+-----------------------------
+
+### Bug fixes:
+
- #9096, #10096: fix a 4.11.0 performance regression in classes/objects
declared within a function
(Gabriel Scherer, review by Leo White, report by Sacha Ayoun)
-- #9326, #10125: Gc.set incorrectly handles the three `custom_*` fields,
- causing a performance regression
- (report by Emilio Jesús Gallego Arias, analysis and fix by Stephen Dolan,
- code by Xavier Leroy, review by Hugo Heuzard and Gabriel Scherer)
-
OCaml 4.11.1 (31 August 2020)
-----------------------------
from a different (older or newer), incompatible compiler version.
(Gabriel Scherer, review by Gabriel Radanne and Damien Doligez)
-- #9181: make objinfo work on Cygwin and look for the caml_plugin_header
- symbol in both the static and the dynamic symbol tables.
- (Sébastien Hinderer, review by Gabriel Scherer and David Allsopp)
-
* #9197: remove compatibility logic from #244 that was designed to
synchronize toplevel printing margins with Format.std_formatter,
but also resulted in unpredictable/fragile changes to formatter
on length of Sys.command argument.
(Xavier Leroy, report by Jérémie Dimino, review by David Allsopp)
-- #9552: restore ocamloptp build and installation
- (Florian Angeletti, review by David Allsopp and Xavier Leroy)
-
### Manual and documentation:
- #9141: beginning of the ocamltest reference manual
compilerlibs, dynlink, ocamltest.
(Gabriel Scherer, review by Vincent Laviron and David Allsopp)
+- #9275: Short circuit simple inclusion checks
+ (Leo White, review by Thomas Refis)
+
- #9305: Avoid polymorphic compare in Ident
(Leo White, review by Xavier Leroy and Gabriel Scherer)
* #9388: Prohibit signature local types with constraints
(Leo White, review by Jacques Garrigue)
+- #7141, #9389: returns exit_code for better user response on linking_error
+ (Anukriti Kumar, review by Gabriel Scherer and Valentin Gatien-Baron)
+
- #9406, #9409: fix an error with packed module types from missing
cmis.
(Florian Angeletti, report by Thomas Leonard, review by Gabriel Radanne
output channels would not be flushed).
(Nicolás Ojeda Bär, review by David Allsopp)
-- #9714, #9724: Use the C++ alignas keyword when compiling in C++.
- Fixes a bug with MSVC C++ 2015/2017. Add a terminator to the
- `caml_domain_state` structure to better ensure that members are
- correctly spaced.
+- #9714, #9724: Use the C++ alignas keyword when compiling in C++ in MSVC.
+ Fixes a bug with MSVC C++ 2015 onwards.
(Antonin Décimo, review by David Allsopp and Xavier Leroy)
- #9736, #9749: Compaction must start in a heap where all free blocks are
blue, which was not the case with the best-fit allocator.
(Damien Doligez, report and review by Leo White)
+### Tools:
+
+- #9552: restore ocamloptp build and installation
+ (Florian Angeletti, review by David Allsopp and Xavier Leroy)
+
OCaml 4.10.0 (21 February 2020)
-------------------------------
- #9127, #9130: ocamldoc: fix the formatting of closing brace in record types.
(David Allsopp, report by San Vu Ngoc)
+- #9181: make objinfo work on Cygwin and look for the caml_plugin_header
+ symbol in both the static and the dynamic symbol tables.
+ (Sébastien Hinderer, review by Gabriel Scherer and David Allsopp)
+
### Build system:
- #8840: use ocaml{c,opt}.opt when available to build internal tools
- #9261: Fix a soundness bug in Rec_check, new in 4.10 (from #8908)
(Vincent Laviron, review by Jeremy Yallop and Gabriel Scherer)
-- #9389: returns exit_code for better user response on linking_error
- (Anukriti Kumar, review by Gabriel Scherer and sliquister)
-
OCaml 4.09 maintenance branch
-----------------------------
- #9050, #9076: install missing compilerlibs/ocamlmiddleend archives
(Gabriel Scherer, review by Florian Angeletti, report by Olaf Hering)
-- #9144, #9180: multiple definitions of global variables in the C runtime,
- causing problems with GCC 10.0 and possibly with other C compilers
- (Xavier Leroy, report by Jürgen Reuter, review by Mark Shinwell)
-
- #9180: pass -fno-common option to C compiler when available,
so as to detect problematic multiple definitions of global variables
in the C runtime
(Xavier Leroy, review by Mark Shinwell)
+- #9144, #9180: multiple definitions of global variables in the C runtime,
+ causing problems with GCC 10.0 and possibly with other C compilers
+ (Xavier Leroy, report by Jürgen Reuter, review by Mark Shinwell)
+
- #9128: Fix a bug in bytecode mode which could lead to a segmentation
fault. The bug was caused by the fact that the atom table shared a
page with some bytecode. The fix makes sure both the atom table and
- #8515: manual, precise constraints on reexported types
(Florian Angeletti, review by Gabriel Scherer)
-- #9327, #9401: manual, fix infix attribute examples
- (Florian Angeletti, report by David Cadé, review by Gabriel Scherer)
-
### Tools:
- #2221: ocamldep will now correctly allow a .ml file in an include directory
(Thomas Refis, review by David Allsopp, Florian Angeletti, Gabriel Radanne,
Gabriel Scherer and Xavier Leroy)
-- #9275: Short circuit simple inclusion checks
- (Leo White, review by Thomas Refis)
-
### Compiler distribution build system:
- #2267: merge generation of header programs, also fixing parallel build on
- #8508: refresh \moduleref macro
(Florian Angeletti, review by Gabriel Scherer)
-- 9410: replaced fibonacci example with gcd of coreexamples manual
- (Anukriti Kumar, review by San Vu Ngoc, Florian Angeletti, Léo Andrès)
-
### Code generation and optimizations:
- #7725, #1754: improve AFL instrumentation for objects and lazy values.
platforms, making this option unusable on platforms where it wasn't.
(Jérémie Dimino, review by Sébastien Hinderer and Xavier Leroy)
-- #9349: Support [@inlined hint] attribute.
- (Leo White, review by Stephen Dolan)
-
### Runtime system:
- #515 #676 #7173: Add a public C API for weak arrays and
----
git checkout -b my-modification
----
+Usually, this branch wants to be based on `trunk`. If your changes must be on a
+specific release, use its release branch (*not* the release tag) instead. For
+example, to make a fix for 4.11.1, base your branch on *4.11* (not on *4.11.1*).
+The `configure` step for the compiler recognises a development build from the
+`+dev` in the version number (see file `VERSION`), and release tarballs and the tagged Git commits do
+not have this which causes some important development things to be disabled
+(ocamltest and converting C compiler warnings to errors).
2. Consult link:INSTALL.adoc[] for build instructions. Here is the gist of it:
+
./configure
make
----
+If you are on a release build and need development options, you can add
+`--enable-ocamltest` (to allow running the testsuite) and `--enable-warn-error`
+(so you don't get caught by CI later!).
3. Try the newly built compiler binaries `ocamlc`, `ocamlopt` or their
`.opt` version. To try the toplevel, use:
make tests
----
-6. Install in a new opam switch to try things out. With `opam` v2, create a local
-opam switch with the compiler installed from the current source directory:
-+
-----
-opam switch create . --empty
-opam install .
-----
-
-7. You did it, Well done! Consult link:CONTRIBUTING.md[] to send your contribution upstream.
+6. You did it, Well done! Consult link:CONTRIBUTING.md[] to send your contribution upstream.
-See our <<Development tips and tricks>> for various helpful details,
-for example on how to automatically <<opam compiler script,create an
-opam switch>> from a compiler branch.
+See also our <<tips,development tips and tricks>>, for example on how to
+<<opam-switch,create an opam switch>> to test your modified compiler.
=== What to do
There is always a lot of potential tasks, both for old and
newcomers. Here are various potential projects:
-* http://caml.inria.fr/mantis/view_all_bug_page.php[The OCaml
+* https://github.com/ocaml/ocaml/issues[The OCaml
bugtracker] contains reported bugs and feature requests. Some
changes that should be accessible to newcomers are marked with the
- tag link:++http://caml.inria.fr/mantis/search.php?
-project_id=1&sticky_issues=1&sortby=last_updated&dir=DESC&highlight_changed=24&hide_status_id=90&tag_string=junior_job++[
- junior_job].
+ tag link:++https://github.com/ocaml/ocaml/issues?q=is%3Aopen+is%3Aissue+label%3Anewcomer-job++[
+ newcomer-job].
* The
https://github.com/ocamllabs/compiler-hacking/wiki/Things-to-work-on[OCaml
Makefile.tools:: used by manual/ and testsuite/ Makefiles
README.adoc:: general information on the compiler distribution
README.win32.adoc:: general information on the Windows ports of OCaml
- VERSION:: version string
+ VERSION:: version string. Run `make configure` after changing.
asmcomp/:: native-code compiler and linker
boot/:: bootstrap compiler
build-aux/: autotools support scripts
utils/:: utility libraries
yacc/:: parser generator
+[#tips]
== Development tips and tricks
=== Keep merge commits when merging and cherry-picking Github PRs
git cherry-pick -x -m 1 <merge-commit-hash>
----
+[#opam-switch]
=== Testing with `opam`
-To test a particular branch `branch` of a public git repository
-`$REPO` of the compiler in an `opam` v2 switch issue:
+If you are working on a development version of the compiler, you can create an
+opam switch from it by running the following from the development repository:
+
+-----
+-opam switch create . --empty
+-opam install .
+-----
+
+If you want to test someone else's development version from a public
+git repository, you can build a switch directly (without cloning their
+work locally) by pinning:
----
-opam switch create ocaml-branch --empty
+opam switch create my-switch-name --empty
# Replace $VERSION by the trunk version
opam pin add ocaml-variants.$VERSION+branch git+https://$REPO#branch
----
the build will revert to the slower bytecode-compiled `ocamlc` until
you do the above step again.
+=== Using merlin
+
+During the development of the compiler, the internal format of compiled object
+files evolves, and quickly becomes incompatible with the format of the last
+OCaml release. In particular, even an up-to-date merlin will be unable to use
+them during most of the development cycle: opening a compiler source file with
+merlin gives a frustrating error message.
+
+To use merlin on the compiler, you want to build the compiler with an older
+version of itself. One easy way to do this is to use the experimental build
+rules for Dune, which are distributed with the compiler (with no guarantees that
+the build will work all the time). Assuming you already have a recent OCaml
+version installed with merlin and dune, you can just run the following from the
+compiler sources:
+
+----
+./configure # if not already done
+make clean && dune build @libs
+----
+
+which will do a bytecode build of all the distribution (without linking
+the executables), using your OCaml compiler, and generate a .merlin
+file.
+
+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
+particular, you need to repeat the dune build every time you change the interface
+of some compilation unit, so that merlin is aware of the new interface.
+
+You only need to run `configure` once, but you will need to run `make clean`
+every time you want to run `dune` after you built something with `make`;
+otherwise dune will complain that build artefacts are present among the sources.
+
+Finally, there will be times where the compiler simply cannot be built with an
+older version of itself. One example of this is when a new primitive is added to
+the runtime, and then used in the standard library straight away, since the rest
+of the compiler requires the `stdlib` library to build, nothing can be build. In
+such situations, you will have to either live without merlin, or develop on an
+older branch of the compiler, for example the maintenance branch of the last
+released version. Developing a patch from a release branch can later introduce a
+substantial amount of extra work, when you rebase to the current development
+version. But it also makes it a lot easier to test the impact of your work on
+third-party code, by installing a local <<opam-switch,opam switch>>: opam
+packages tend to be compatible with released versions of the compiler, whereas
+most packages are incompatible with the in-progress development version.
+
=== Continuous integration
==== Github's CI: Travis and AppVeyor
== Prerequisites
-* The GNU C Compiler (gcc) is recommended, as the bytecode interpreter takes
+* 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, OS X, and many other systems.
+ compiler under Linux and many other systems.
+ However `clang` - used in Mac OS, BSDs and others - also works fine.
+
+* GNU `make`, as well as POSIX-compatible `awk` and `sed` are required.
+
+* A POSIX-compatible `diff` is necessary to run the test suite.
* If you do not have write access to `/tmp`, you should set the environment
variable `TMPDIR` to the name of some other temporary directory.
-* Under HP/UX, the GNU C Compiler (gcc), the GNU Assembler (gas), and GNU Make
- are all *required*. The vendor-provided compiler, assembler and make tools
- have major problems.
+== Prerequisites (special cases)
-* Under Cygwin, the `gcc-core` and `make` packages are required. `flexdll` is
- necessary for shared library support. `libX11-devel` is necessary for graph
- library support and `libintl-devel` is necessary for the `ocamlobjinfo` tool
- to be able to process `.cmxs` files. `diffutils` is necessary to run the test
- suite.
+* Under Cygwin, the `gcc-core` package is required. `flexdll` is also necessary
+ for shared library support.
== Configuration
for _both_ `configure` and `make world` phases. Note, if this variable is set for only one phase,
your build will break (`ocamlrun` segfaults).
+
+* For Solaris/Illumos on SPARC machines with Sun PRO compiler only 64-bit
+ bytecode target is supported (32-bit fails due to alignment issues; the optimization
+ is preset to `-O4` for inlining):
+
+ ./configure CC="cc -m64"
++
If something goes wrong during the automatic configuration, or if the generated
files cause errors later on, then look at the template files:
Makefile.config.in
- Makefile.common.in
+ Makefile.build_config.in
runtime/caml/m.h.in
runtime/caml/s.h.in
+
# The main Makefile
ROOTDIR = .
-
-# The configure and *clean targets can all be run without running ./configure
-# first.
-# If no goals were specified (i.e. `make`), add defaultentry (since it requires
-# ./configure to be run)
-CAN_BE_UNCONFIGURED := $(strip \
- $(filter-out partialclean clean distclean configure, \
- $(if $(MAKECMDGOALS),$(MAKECMDGOALS),defaultentry)))
-
-ifeq "$(CAN_BE_UNCONFIGURED)" ""
--include Makefile.config
--include Makefile.common
-else
-include Makefile.config
include Makefile.common
-endif
.PHONY: defaultentry
ifeq "$(NATIVE_COMPILER)" "true"
defaultentry: world
endif
-MKDIR=mkdir -p
ifeq "$(UNIX_OR_WIN32)" "win32"
LN = cp
else
include stdlib/StdlibModules
CAMLC=$(BOOT_OCAMLC) -g -nostdlib -I boot -use-prims runtime/primitives
-CAMLOPT=$(CAMLRUN) ./ocamlopt -g -nostdlib -I stdlib -I otherlibs/dynlink
+CAMLOPT=$(CAMLRUN) ./ocamlopt$(EXE) -g -nostdlib -I stdlib -I otherlibs/dynlink
ARCHES=amd64 i386 arm arm64 power s390x riscv
INCLUDES=-I utils -I parsing -I typing -I bytecomp -I file_formats \
-I lambda -I middle_end -I middle_end/closure \
OCAML_NATDYNLINKOPTS = -ccopt "$(NATDYNLINKOPTS)"
endif
-YACCFLAGS=-v --strict
CAMLLEX=$(CAMLRUN) boot/ocamllex
CAMLDEP=$(CAMLRUN) boot/ocamlc -depend
DEPFLAGS=-slash
COMPLIBDIR=$(LIBDIR)/compiler-libs
TOPINCLUDES=$(addprefix -I otherlibs/,$(filter-out %threads,$(OTHERLIBRARIES)))
-RUNTOP=./runtime/ocamlrun ./ocaml \
- -nostdlib -I stdlib \
+RUNTOP=./runtime/ocamlrun$(EXE) ./ocaml$(EXE) \
+ -nostdlib -I stdlib -I toplevel \
-noinit $(TOPFLAGS) $(TOPINCLUDES)
NATRUNTOP=./ocamlnat$(EXE) \
- -nostdlib -I stdlib \
+ -nostdlib -I stdlib -I toplevel \
-noinit $(TOPFLAGS) $(TOPINCLUDES)
ifeq "$(UNIX_OR_WIN32)" "unix"
EXTRAPATH=
ifeq "$(FLEXDLL_SUBMODULE_PRESENT)" ""
BOOT_FLEXLINK_CMD =
else
- BOOT_FLEXLINK_CMD = FLEXLINK_CMD="../boot/ocamlrun ../flexdll/flexlink.exe"
+ BOOT_FLEXLINK_CMD = \
+ FLEXLINK_CMD="../boot/ocamlrun$(EXE) ../flexdll/flexlink.exe"
endif
else
endif
+expunge := expunge$(EXE)
+
# targets for the compilerlibs/*.{cma,cmxa} archives
include compilerlibs/Makefile.compilerlibs
.PHONY: beforedepend
beforedepend:: utils/config.ml utils/domainstate.ml utils/domainstate.mli
+programs := expunge ocaml ocamlc ocamlc.opt ocamlnat ocamlopt ocamlopt.opt
+
+$(foreach program, $(programs), $(eval $(call PROGRAM_SYNONYM,$(program))))
+
# Start up the system from the distribution compiler
.PHONY: coldstart
coldstart:
# Build the core system: the minimum needed to make depend and bootstrap
.PHONY: core
-core:
- $(MAKE) coldstart
+core: coldstart
$(MAKE) coreall
# Check if fixpoint reached
+
+CMPBYT := $(CAMLRUN) tools/cmpbyt$(EXE)
+
.PHONY: compare
compare:
- @if $(CAMLRUN) tools/cmpbyt boot/ocamlc ocamlc \
- && $(CAMLRUN) tools/cmpbyt boot/ocamllex lex/ocamllex; \
+ @if $(CMPBYT) boot/ocamlc ocamlc$(EXE) \
+ && $(CMPBYT) boot/ocamllex lex/ocamllex$(EXE); \
then echo "Fixpoint reached, bootstrap succeeded."; \
else \
echo "Fixpoint not reached, try one more bootstrapping cycle."; \
.PHONY: promote-common
promote-common:
- $(PROMOTE) ocamlc boot/ocamlc
- $(PROMOTE) lex/ocamllex boot/ocamllex
+ $(PROMOTE) ocamlc$(EXE) boot/ocamlc
+ $(PROMOTE) lex/ocamllex$(EXE) boot/ocamllex
cd stdlib; cp $(LIBFILES) ../boot
# Promote the newly compiled system to the rank of cross compiler
# Rebuild the library (using runtime/ocamlrun ./ocamlc)
$(MAKE) library-cross
# Promote the new compiler and the new runtime
- $(MAKE) CAMLRUN=runtime/ocamlrun promote
+ $(MAKE) CAMLRUN=runtime/ocamlrun$(EXE) promote
# Rebuild the core system
$(MAKE) partialclean
$(MAKE) core
MSVC_DETECT=0 CHAINS=$(FLEXDLL_CHAIN) NATDYNLINK=false support
# Bootstrapping flexlink - leaves a bytecode image of flexlink.exe in flexdll/
+FLEXLINK_OCAMLOPT = \
+ ../boot/ocamlrun$(EXE) ../boot/ocamlc \
+ -use-prims ../runtime/primitives -nostdlib -I ../boot
+
.PHONY: flexlink
flexlink: flexdll/Makefile
$(MAKE) -C runtime BOOTSTRAPPING_FLEXLINK=yes ocamlrun$(EXE)
cp runtime/ocamlrun$(EXE) boot/ocamlrun$(EXE)
- $(MAKE) -C stdlib COMPILER=../boot/ocamlc \
- $(filter-out *.cmi,$(LIBFILES))
+ $(MAKE) -C stdlib \
+ COMPILER="../boot/ocamlc -use-prims ../runtime/primitives" \
+ $(filter-out *.cmi,$(LIBFILES))
cd stdlib && cp $(LIBFILES) ../boot/
$(MAKE) -C flexdll MSVC_DETECT=0 OCAML_CONFIG_FILE=../Makefile.config \
CHAINS=$(FLEXDLL_CHAIN) NATDYNLINK=false \
- OCAMLOPT="../boot/ocamlrun ../boot/ocamlc -nostdlib -I ../boot" \
+ OCAMLOPT="$(FLEXLINK_OCAMLOPT)" \
flexlink.exe
$(MAKE) -C runtime clean
$(MAKE) partialclean
flexlink.opt:
cd flexdll && \
mv flexlink.exe flexlink && \
- ($(MAKE) OCAML_FLEXLINK="../boot/ocamlrun ./flexlink" MSVC_DETECT=0 \
- OCAML_CONFIG_FILE=../Makefile.config \
- OCAMLOPT="../ocamlopt.opt -nostdlib -I ../stdlib" \
+ ($(MAKE) OCAML_FLEXLINK="../boot/ocamlrun$(EXE) ./flexlink" \
+ MSVC_DETECT=0 OCAML_CONFIG_FILE=../Makefile.config \
+ OCAMLOPT="../ocamlopt.opt$(EXE) -nostdlib -I ../stdlib" \
flexlink.exe || \
(mv flexlink flexlink.exe && false)) && \
mv flexlink.exe flexlink.opt && \
$(MKDIR) "$(INSTALL_LIBDIR)"
$(MKDIR) "$(INSTALL_STUBLIBDIR)"
$(MKDIR) "$(INSTALL_COMPLIBDIR)"
- $(INSTALL_DATA) \
- VERSION \
- "$(INSTALL_LIBDIR)"
$(MAKE) -C runtime install
- $(INSTALL_PROG) ocaml "$(INSTALL_BINDIR)/ocaml$(EXE)"
+ $(INSTALL_PROG) ocaml$(EXE) "$(INSTALL_BINDIR)"
ifeq "$(INSTALL_BYTECODE_PROGRAMS)" "true"
- $(INSTALL_PROG) ocamlc "$(INSTALL_BINDIR)/ocamlc.byte$(EXE)"
+ $(INSTALL_PROG) ocamlc$(EXE) "$(INSTALL_BINDIR)/ocamlc.byte$(EXE)"
endif
$(MAKE) -C stdlib install
ifeq "$(INSTALL_BYTECODE_PROGRAMS)" "true"
- $(INSTALL_PROG) lex/ocamllex "$(INSTALL_BINDIR)/ocamllex.byte$(EXE)"
+ $(INSTALL_PROG) lex/ocamllex$(EXE) \
+ "$(INSTALL_BINDIR)/ocamllex.byte$(EXE)"
endif
- $(INSTALL_PROG) yacc/ocamlyacc$(EXE) "$(INSTALL_BINDIR)/ocamlyacc$(EXE)"
+ $(INSTALL_PROG) yacc/ocamlyacc$(EXE) "$(INSTALL_BINDIR)"
$(INSTALL_DATA) \
utils/*.cmi \
parsing/*.cmi \
$(INSTALL_DATA) \
$(BYTESTART) $(TOPLEVELSTART) \
"$(INSTALL_COMPLIBDIR)"
- $(INSTALL_PROG) expunge "$(INSTALL_LIBDIR)/expunge$(EXE)"
+ $(INSTALL_PROG) $(expunge) "$(INSTALL_LIBDIR)"
$(INSTALL_DATA) \
toplevel/topdirs.cmi \
"$(INSTALL_LIBDIR)"
for i in $(OTHERLIBRARIES); do \
$(MAKE) -C otherlibs/$$i install || exit $$?; \
done
-# Transitional: findlib 1.7.3 is confused if leftover num.cm? files remain
-# from an previous installation of OCaml before otherlibs/num was removed.
- rm -f "$(INSTALL_LIBDIR)"/num.cm?
-# End transitional
ifneq "$(WITH_OCAMLDOC)" ""
$(MAKE) -C ocamldoc install
endif
$(MAKE) install-flexdll; \
fi
endif
- $(INSTALL_DATA) Makefile.config "$(INSTALL_LIBDIR)/Makefile.config"
+ $(INSTALL_DATA) Makefile.config "$(INSTALL_LIBDIR)"
ifeq "$(INSTALL_BYTECODE_PROGRAMS)" "true"
- if test -f ocamlopt; then $(MAKE) installopt; else \
+ if test -f ocamlopt$(EXE); then $(MAKE) installopt; else \
cd "$(INSTALL_BINDIR)"; \
$(LN) ocamlc.byte$(EXE) ocamlc$(EXE); \
$(LN) ocamllex.byte$(EXE) ocamllex$(EXE); \
fi
else
- if test -f ocamlopt; then $(MAKE) installopt; fi
+ if test -f ocamlopt$(EXE); then $(MAKE) installopt; fi
endif
# Installation of the native-code compiler
installopt:
$(MAKE) -C runtime installopt
ifeq "$(INSTALL_BYTECODE_PROGRAMS)" "true"
- $(INSTALL_PROG) ocamlopt "$(INSTALL_BINDIR)/ocamlopt.byte$(EXE)"
+ $(INSTALL_PROG) ocamlopt$(EXE) "$(INSTALL_BINDIR)/ocamlopt.byte$(EXE)"
endif
$(MAKE) -C stdlib installopt
$(INSTALL_DATA) \
$(MAKE) -C otherlibs/$$i installopt || exit $$?; \
done
ifeq "$(INSTALL_BYTECODE_PROGRAMS)" "true"
- if test -f ocamlopt.opt ; then $(MAKE) installoptopt; else \
+ if test -f ocamlopt.opt$(EXE); then $(MAKE) installoptopt; else \
cd "$(INSTALL_BINDIR)"; \
$(LN) ocamlc.byte$(EXE) ocamlc$(EXE); \
$(LN) ocamlopt.byte$(EXE) ocamlopt$(EXE); \
$(LN) ocamllex.byte$(EXE) ocamllex$(EXE); \
fi
else
- if test -f ocamlopt.opt ; then $(MAKE) installoptopt; fi
+ if test -f ocamlopt.opt$(EXE); then $(MAKE) installoptopt; fi
endif
$(MAKE) -C tools installopt
- if test -f ocamlopt.opt -a -f flexdll/flexlink.opt ; then \
+ if test -f ocamlopt.opt$(EXE) -a -f flexdll/flexlink.opt ; then \
$(INSTALL_PROG) \
flexdll/flexlink.opt "$(INSTALL_BINDIR)/flexlink$(EXE)" ; \
fi
.PHONY: installoptopt
installoptopt:
- $(INSTALL_PROG) ocamlc.opt "$(INSTALL_BINDIR)/ocamlc.opt$(EXE)"
- $(INSTALL_PROG) ocamlopt.opt "$(INSTALL_BINDIR)/ocamlopt.opt$(EXE)"
- $(INSTALL_PROG) \
- lex/ocamllex.opt "$(INSTALL_BINDIR)/ocamllex.opt$(EXE)"
+ $(INSTALL_PROG) ocamlc.opt$(EXE) "$(INSTALL_BINDIR)"
+ $(INSTALL_PROG) ocamlopt.opt$(EXE) "$(INSTALL_BINDIR)"
+ $(INSTALL_PROG) lex/ocamllex.opt$(EXE) "$(INSTALL_BINDIR)"
cd "$(INSTALL_BINDIR)"; \
$(LN) ocamlc.opt$(EXE) ocamlc$(EXE); \
$(LN) ocamlopt.opt$(EXE) ocamlopt$(EXE); \
$(OPTSTART:.cmo=.cmx) $(OPTSTART:.cmo=.$(O)) \
"$(INSTALL_COMPLIBDIR)"
if test -f ocamlnat$(EXE) ; then \
- $(INSTALL_PROG) \
- ocamlnat$(EXE) "$(INSTALL_BINDIR)/ocamlnat$(EXE)"; \
+ $(INSTALL_PROG) ocamlnat$(EXE) "$(INSTALL_BINDIR)"; \
$(INSTALL_DATA) \
toplevel/opttopdirs.cmi \
"$(INSTALL_LIBDIR)"; \
# The clean target
clean:: partialclean
+ rm -f $(programs) $(programs:=.exe)
# The bytecode compiler
-ocamlc: compilerlibs/ocamlcommon.cma compilerlibs/ocamlbytecomp.cma $(BYTESTART)
+ocamlc$(EXE): compilerlibs/ocamlcommon.cma \
+ compilerlibs/ocamlbytecomp.cma $(BYTESTART)
$(CAMLC) $(LINKFLAGS) -compat-32 -o $@ $^
partialclean::
- rm -rf ocamlc
+ rm -rf ocamlc$(EXE)
# The native-code compiler
-ocamlopt: compilerlibs/ocamlcommon.cma compilerlibs/ocamloptcomp.cma \
+ocamlopt$(EXE): compilerlibs/ocamlcommon.cma compilerlibs/ocamloptcomp.cma \
$(OPTSTART)
$(CAMLC) $(LINKFLAGS) -o $@ $^
partialclean::
- rm -f ocamlopt
+ rm -f ocamlopt$(EXE)
# The toplevel
ocaml.tmp: $(ocaml_dependencies)
$(CAMLC) $(LINKFLAGS) -linkall -o $@ $^
-ocaml: expunge ocaml.tmp
+ocaml$(EXE): $(expunge) ocaml.tmp
- $(CAMLRUN) $^ $@ $(PERVASIVES)
partialclean::
- rm -f ocaml
+ rm -f ocaml$(EXE)
.PHONY: runtop
runtop:
$(MAKE) ocamlc
$(MAKE) otherlibraries
$(MAKE) ocaml
- @rlwrap --help 2>/dev/null && $(EXTRAPATH) rlwrap $(RUNTOP) ||\
- $(EXTRAPATH) $(RUNTOP)
+ @$(EXTRAPATH) $(RLWRAP) $(RUNTOP)
.PHONY: natruntop
natruntop:
$(MAKE) core
$(MAKE) opt
$(MAKE) ocamlnat
- @rlwrap --help 2>/dev/null && $(EXTRAPATH) rlwrap $(NATRUNTOP) ||\
- $(EXTRAPATH) $(NATRUNTOP)
+ @$(FLEXLINK_ENV) $(EXTRAPATH) $(RLWRAP) $(NATRUNTOP)
# Native dynlink
# The bytecode compiler compiled with the native-code compiler
-ocamlc.opt: compilerlibs/ocamlcommon.cmxa compilerlibs/ocamlbytecomp.cmxa \
- $(BYTESTART:.cmo=.cmx)
+ocamlc.opt$(EXE): compilerlibs/ocamlcommon.cmxa \
+ compilerlibs/ocamlbytecomp.cmxa $(BYTESTART:.cmo=.cmx)
$(CAMLOPT_CMD) $(LINKFLAGS) -o $@ $^ -cclib "$(BYTECCLIBS)"
partialclean::
- rm -f ocamlc.opt
+ rm -f ocamlc.opt$(EXE)
# The native-code compiler compiled with itself
-ocamlopt.opt: compilerlibs/ocamlcommon.cmxa compilerlibs/ocamloptcomp.cmxa \
- $(OPTSTART:.cmo=.cmx)
+ocamlopt.opt$(EXE): \
+ compilerlibs/ocamlcommon.cmxa \
+ compilerlibs/ocamloptcomp.cmxa \
+ $(OPTSTART:.cmo=.cmx)
$(CAMLOPT_CMD) $(LINKFLAGS) -o $@ $^
partialclean::
- rm -f ocamlopt.opt
+ rm -f ocamlopt.opt$(EXE)
# The predefined exceptions and primitives
# Preprocess the code emitters
-asmcomp/emit.ml: asmcomp/$(ARCH)/emit.mlp tools/cvt_emit
+cvt_emit := tools/cvt_emit$(EXE)
+
+asmcomp/emit.ml: asmcomp/$(ARCH)/emit.mlp $(cvt_emit)
echo \# 1 \"$(ARCH)/emit.mlp\" > $@
- $(CAMLRUN) tools/cvt_emit < $< >> $@ \
+ $(CAMLRUN) $(cvt_emit) < $< >> $@ \
|| { rm -f $@; exit 2; }
partialclean::
beforedepend:: asmcomp/emit.ml
-tools/cvt_emit: tools/cvt_emit.mll
+$(cvt_emit): tools/cvt_emit.mll
$(MAKE) -C tools cvt_emit
# The "expunge" utility
-expunge: compilerlibs/ocamlcommon.cma compilerlibs/ocamlbytecomp.cma \
+$(expunge): compilerlibs/ocamlcommon.cma compilerlibs/ocamlbytecomp.cma \
toplevel/expunge.cmo
$(CAMLC) $(LINKFLAGS) -o $@ $^
partialclean::
- rm -f expunge
+ rm -f $(expunge)
# The runtime system for the bytecode compiler
$(MAKE) -C runtime clean
rm -f stdlib/libcamlrun.a stdlib/libcamlrun.lib
-otherlibs_all := bigarray dynlink raw_spacetime_lib \
+otherlibs_all := bigarray dynlink \
str systhreads unix win32unix
-subdirs := debugger lex ocamldoc ocamltest runtime stdlib tools \
+subdirs := debugger lex ocamldoc ocamltest stdlib tools \
$(addprefix otherlibs/, $(otherlibs_all)) \
.PHONY: alldepend
-ifeq "$(TOOLCHAIN)" "msvc"
-alldepend:
- $(error Dependencies cannot be regenerated using the MSVC ports)
-else
alldepend: depend
for dir in $(subdirs); do \
$(MAKE) -C $$dir depend || exit; \
done
-endif
# The runtime system for the native-code compiler
.PHONY: library-cross
library-cross:
- $(MAKE) -C stdlib $(BOOT_FLEXLINK_CMD) CAMLRUN=../runtime/ocamlrun all
+ $(MAKE) -C stdlib \
+ $(BOOT_FLEXLINK_CMD) CAMLRUN=../runtime/ocamlrun$(EXE) all
.PHONY: libraryopt
libraryopt:
$(MAKE) -C ocamldoc opt.opt
# OCamltest
-ocamltest: ocamlc ocamlyacc ocamllex
+ocamltest: ocamlc ocamlyacc ocamllex otherlibraries
$(MAKE) -C ocamltest all
ocamltest.opt: ocamlc.opt ocamlyacc ocamllex
# Check that the native-code compiler is supported
.PHONY: checknative
checknative:
+ifneq "$(NATIVE_COMPILER)" "true"
+ $(error The source tree was configured with --disable-native-compiler!)
+else
ifeq "$(ARCH)" "none"
-checknative:
$(error The native-code compiler is not supported on this platform)
else
@
endif
+endif
# Check that the stack limit is reasonable (Unix-only)
.PHONY: checkstack
-checkstack:
ifeq "$(UNIX_OR_WIN32)" "unix"
- if $(MKEXE) $(OUTPUTEXE)tools/checkstack$(EXE) tools/checkstack.c; \
- then tools/checkstack$(EXE); \
- fi
- rm -f tools/checkstack$(EXE)
+checkstack := tools/checkstack
+checkstack: $(checkstack)$(EXE)
+ $<
+
+.INTERMEDIATE: $(checkstack)$(EXE) $(checkstack).$(O)
+$(checkstack)$(EXE): $(checkstack).$(O)
+ $(MKEXE) $(OUTPUTEXE)$@ $<
else
+checkstack:
@
endif
lintapidiff:
$(MAKE) -C tools lintapidiff.opt
git ls-files -- 'otherlibs/*/*.mli' 'stdlib/*.mli' |\
- grep -Ev internal\|obj\|spacetime\|stdLabels\|moreLabels |\
+ grep -Ev internal\|obj\|stdLabels\|moreLabels |\
tools/lintapidiff.opt $(VERSIONS)
# Tools
## Test compilation of backend-specific parts
+ARCH_SPECIFIC =\
+ asmcomp/arch.ml asmcomp/proc.ml asmcomp/CSE.ml asmcomp/selection.ml \
+ asmcomp/scheduling.ml asmcomp/reload.ml
+
partialclean::
rm -f $(ARCH_SPECIFIC)
# The native toplevel
-# When the native toplevel executable has an extension (e.g. ".exe"),
-# provide a phony 'ocamlnat' synonym
-
-ifneq ($(EXE),)
-.PHONY: ocamlnat
-ocamlnat: ocamlnat$(EXE)
-endif
-
ocamlnat$(EXE): compilerlibs/ocamlcommon.cmxa compilerlibs/ocamloptcomp.cmxa \
compilerlibs/ocamlbytecomp.cmxa \
otherlibs/dynlink/dynlink.cmxa \
# The numeric opcodes
-bytecomp/opcodes.ml: runtime/caml/instruct.h tools/make_opcodes
- runtime/ocamlrun tools/make_opcodes -opcodes < $< > $@
+make_opcodes := tools/make_opcodes$(EXE)
+
+bytecomp/opcodes.ml: runtime/caml/instruct.h $(make_opcodes)
+ runtime/ocamlrun$(EXE) $(make_opcodes) -opcodes < $< > $@
bytecomp/opcodes.mli: bytecomp/opcodes.ml
$(CAMLC) -i $< > $@
-tools/make_opcodes: tools/make_opcodes.mll
+$(make_opcodes): tools/make_opcodes.mll
$(MAKE) -C tools make_opcodes
partialclean::
.PHONY: distclean
distclean: clean
- rm -f boot/ocamlrun boot/ocamlrun boot/ocamlrun.exe boot/camlheader \
+ rm -f boot/ocamlrun boot/ocamlrun.exe boot/camlheader \
boot/*.cm* boot/libcamlrun.a boot/libcamlrun.lib boot/ocamlc.opt
- rm -f Makefile.config Makefile.common runtime/caml/m.h runtime/caml/s.h
+ rm -f Makefile.config Makefile.build_config
+ rm -f runtime/caml/m.h runtime/caml/s.h
rm -rf autom4te.cache
rm -f config.log config.status libtool
rm -f tools/eventlog_metadata
rm -f tools/*.bak
- rm -f ocaml ocamlc
rm -f testsuite/_log*
include .depend
-
-ifneq "$(strip $(CAN_BE_UNCONFIGURED))" ""
-Makefile.config Makefile.common: config.status
-
+Makefile.config Makefile.build_config: config.status
config.status:
@echo "Please refer to the installation instructions:"
@echo "- In file INSTALL for Unix systems."
@echo " make install"
@echo "should work."
@false
-endif
# native binary, if available. Note that they never use the boot/
# versions: we assume that ocamlc, ocamlopt, etc. have been run first.
+# Set this to empty to force use of the bytecode compilers at all times
+USE_BEST_BINARIES ?= true
+
check_not_stale = \
$(if $(shell test $(ROOTDIR)/$1 -nt $(ROOTDIR)/$2 && echo stale), \
$(info Warning: we are not using the native binary $2 \
ok)
choose_best = $(strip $(if \
- $(and $(wildcard $(ROOTDIR)/$1.opt),$(strip \
- $(call check_not_stale,$1,$1.opt))), \
- $(ROOTDIR)/$1.opt, \
- $(CAMLRUN) $(ROOTDIR)/$1))
+ $(and $(USE_BEST_BINARIES),$(wildcard $(ROOTDIR)/$1.opt$(EXE)),$(strip \
+ $(call check_not_stale,$1$(EXE),$1.opt$(EXE)))), \
+ $(ROOTDIR)/$1.opt$(EXE), \
+ $(CAMLRUN) $(ROOTDIR)/$1$(EXE)))
BEST_OCAMLC := $(call choose_best,ocamlc)
BEST_OCAMLOPT := $(call choose_best,ocamlopt)
BEST_OCAMLLEX := $(call choose_best,lex/ocamllex)
-BEST_OCAMLDEP := $(BEST_OCAMLC) -depend
+# We want to be able to compute dependencies even if the bytecode compiler
+# is not built yet, using the bootstrap compiler.
+
+# Unlike other tools, there is no risk of mixing incompatible
+# bootrap-compiler and host-compiler object files, as ocamldep only
+# produces text output.
+BEST_OCAMLDEP := $(strip $(if \
+ $(and $(USE_BEST_BINARIES),$(wildcard $(ROOTDIR)/ocamlc.opt$(EXE)),$(strip \
+ $(call check_not_stale,boot/ocamlc,ocamlc.opt$(EXE)))), \
+ $(ROOTDIR)/ocamlc.opt$(EXE) -depend, \
+ $(BOOT_OCAMLC) -depend))
--- /dev/null
+# @configure_input@
+
+#**************************************************************************
+#* *
+#* OCaml *
+#* *
+#* David Allsopp, OCaml Labs, Cambridge. *
+#* *
+#* Copyright 2020 MetaStack Solutions Ltd. *
+#* *
+#* All rights reserved. This file is distributed under the terms of *
+#* the GNU Lesser General Public License version 2.1, with the *
+#* special exception on linking described in the file LICENSE. *
+#* *
+#**************************************************************************
+
+# This Makefile contains configuration gleaned by configure but which should not
+# be installed in Makefile.config. The file is designed to be included in
+# OCaml's build system and so itself includes Makefile.config. It assumes that
+# $(ROOTDIR) has been defined.
+
+include $(ROOTDIR)/Makefile.config
+INSTALL ?= @INSTALL@
+INSTALL_DATA ?= @INSTALL_DATA@
+INSTALL_PROG ?= @INSTALL_PROGRAM@
+
+# The command to generate C dependency information
+DEP_CC=@DEP_CC@ -MM
+COMPUTE_DEPS=@compute_deps@
+
+# This is munged into utils/config.ml, not overridable by other parts of
+# the build system.
+OC_DLL_LDFLAGS=@oc_dll_ldflags@
+
+# The rlwrap command (for the *runtop targets)
+RLWRAP=@rlwrap@
--- /dev/null
+#**************************************************************************
+#* *
+#* OCaml *
+#* *
+#* Gabriel Scherer, projet Parsifal, INRIA Saclay *
+#* *
+#* Copyright 2018 Institut National de Recherche en Informatique et *
+#* en Automatique. *
+#* *
+#* All rights reserved. This file is distributed under the terms of *
+#* the GNU Lesser General Public License version 2.1, with the *
+#* special exception on linking described in the file LICENSE. *
+#* *
+#**************************************************************************
+
+# This makefile contains common definitions and rules shared by
+# other Makefiles
+
+include $(ROOTDIR)/Makefile.config_if_required
+
+# %(DEPDIR) must be kept in sync with entries in .gitignore
+DEPDIR=.dep
+D=d
+MKDIR=mkdir -p
+
+DESTDIR ?=
+INSTALL_BINDIR := $(DESTDIR)$(BINDIR)
+INSTALL_LIBDIR := $(DESTDIR)$(LIBDIR)
+INSTALL_STUBLIBDIR := $(DESTDIR)$(STUBLIBDIR)
+INSTALL_MANDIR := $(DESTDIR)$(MANDIR)
+
+ifeq "$(UNIX_OR_WIN32)" "win32"
+FLEXDLL_SUBMODULE_PRESENT := $(wildcard $(ROOTDIR)/flexdll/Makefile)
+else
+FLEXDLL_SUBMODULE_PRESENT =
+endif
+
+# Use boot/ocamlc.opt if available
+CAMLRUN ?= $(ROOTDIR)/boot/ocamlrun$(EXE)
+ifeq (0,$(shell \
+ test $(ROOTDIR)/boot/ocamlc.opt -nt $(ROOTDIR)/boot/ocamlc; \
+ echo $$?))
+ BOOT_OCAMLC = $(ROOTDIR)/boot/ocamlc.opt
+else
+ BOOT_OCAMLC = $(CAMLRUN) $(ROOTDIR)/boot/ocamlc
+endif
+
+ifeq "$(FLEXDLL_SUBMODULE_PRESENT)" ""
+ FLEXLINK_ENV =
+ CAMLOPT_CMD = $(CAMLOPT)
+ OCAMLOPT_CMD = $(OCAMLOPT)
+ MKLIB_CMD = $(MKLIB)
+ ocamlc_cmd = $(ocamlc)
+ ocamlopt_cmd = $(ocamlopt)
+else
+ FLEXLINK_ENV = \
+ OCAML_FLEXLINK="$(ROOTDIR)/boot/ocamlrun $(ROOTDIR)/flexdll/flexlink.exe"
+ CAMLOPT_CMD = $(FLEXLINK_ENV) $(CAMLOPT)
+ OCAMLOPT_CMD = $(FLEXLINK_ENV) $(OCAMLOPT)
+ MKLIB_CMD = $(FLEXLINK_ENV) $(MKLIB)
+ ocamlc_cmd = $(FLEXLINK_ENV) $(ocamlc)
+ ocamlopt_cmd = $(FLEXLINK_ENV) $(ocamlopt)
+endif
+
+OPTCOMPFLAGS=
+ifeq "$(FUNCTION_SECTIONS)" "true"
+OPTCOMPFLAGS += -function-sections
+endif
+# By default, request ocamllex to be quiet
+OCAMLLEX_FLAGS ?= -q
+
+# Escape special characters in the argument string.
+# There are four characters that need escaping:
+# - backslash and ampersand, which are special in the replacement text
+# of sed's "s" command
+# - exclamation mark, which is the delimiter we use for sed's "s" command
+# - single quote, which interferes with shell quoting. We are inside
+# single quotes already, so the proper escape is '\''
+# (close single quotation, insert single quote character,
+# reopen single quotation).
+SED_ESCAPE=$(subst ','\'',$(subst !,\!,$(subst &,\&,$(subst \,\\,$1))))
+
+# Escape special characters in an OCaml string literal "..."
+# There are two: backslash and double quote.
+OCAML_ESCAPE=$(subst ",\",$(subst \,\\,$1))
+
+# SUBST generates the sed substitution for the variable *named* in $1
+SUBST=-e 's!%%$1%%!$(call SED_ESCAPE,$($1))!'
+
+# SUBST_STRING does the same, for a variable that occurs between "..."
+# in config.mlp. Thus, backslashes and double quotes must be escaped.
+SUBST_STRING=-e 's!%%$1%%!$(call SED_ESCAPE,$(call OCAML_ESCAPE,$($1)))!'
+
+# The rule to compile C files
+
+# This rule is similar to GNU make's implicit rule, except that it is more
+# general (it supports both .o and .obj)
+
+ifneq "$(COMPUTE_DEPS)" "false"
+RUNTIME_HEADERS :=
+REQUIRED_HEADERS :=
+else
+RUNTIME_HEADERS := $(wildcard $(ROOTDIR)/runtime/caml/*.tbl) \
+ $(wildcard $(ROOTDIR)/runtime/caml/*.h)
+REQUIRED_HEADERS := $(RUNTIME_HEADERS) $(wildcard *.h)
+endif
+
+%.$(O): %.c $(REQUIRED_HEADERS)
+ $(CC) -c $(OC_CFLAGS) $(CFLAGS) $(OC_CPPFLAGS) $(CPPFLAGS) \
+ $(OUTPUTOBJ)$@ $<
+
+$(DEPDIR):
+ $(MKDIR) $@
+
+# When executable files have an extension (e.g. ".exe"),
+# provide phony synonyms
+define PROGRAM_SYNONYM
+ifneq ($(EXE),)
+.PHONY: $(1)
+$(1): $(1)$(EXE)
+endif
+endef # PROGRAM_SYNONYM
+++ /dev/null
-# @configure_input@
-
-#**************************************************************************
-#* *
-#* OCaml *
-#* *
-#* Gabriel Scherer, projet Parsifal, INRIA Saclay *
-#* *
-#* Copyright 2018 Institut National de Recherche en Informatique et *
-#* en Automatique. *
-#* *
-#* All rights reserved. This file is distributed under the terms of *
-#* the GNU Lesser General Public License version 2.1, with the *
-#* special exception on linking described in the file LICENSE. *
-#* *
-#**************************************************************************
-
-# This makefile contains common definitions and rules shared by
-# other Makefiles
-# We assume that Makefile.config has already been included
-
-INSTALL ?= @INSTALL@
-INSTALL_DATA ?= $(INSTALL) -m u=rw,g=rw,o=r
-INSTALL_PROG ?= $(INSTALL) -m u=rwx,g=rwx,o=rx
-
-# note: these are defined by lazy expansions
-# as some parts of the makefiles change BINDIR, etc.
-# and expect INSTALL_BINDIR, etc. to stay in synch
-# (see `shellquote` in tools/Makefile)
-DESTDIR ?=
-INSTALL_BINDIR = $(DESTDIR)$(BINDIR)
-INSTALL_LIBDIR = $(DESTDIR)$(LIBDIR)
-INSTALL_STUBLIBDIR = $(DESTDIR)$(STUBLIBDIR)
-INSTALL_MANDIR = $(DESTDIR)$(MANDIR)
-
-ifeq "$(UNIX_OR_WIN32)" "win32"
-FLEXDLL_SUBMODULE_PRESENT := $(wildcard $(ROOTDIR)/flexdll/Makefile)
-else
-FLEXDLL_SUBMODULE_PRESENT =
-endif
-
-# Use boot/ocamlc.opt if available
-CAMLRUN ?= $(ROOTDIR)/boot/ocamlrun
-ifeq (0,$(shell \
- test $(ROOTDIR)/boot/ocamlc.opt -nt $(ROOTDIR)/boot/ocamlc; \
- echo $$?))
- BOOT_OCAMLC = $(ROOTDIR)/boot/ocamlc.opt
-else
- BOOT_OCAMLC = $(CAMLRUN) $(ROOTDIR)/boot/ocamlc
-endif
-
-ifeq "$(FLEXDLL_SUBMODULE_PRESENT)" ""
- FLEXLINK_ENV =
- CAMLOPT_CMD = $(CAMLOPT)
- OCAMLOPT_CMD = $(OCAMLOPT)
- MKLIB_CMD = $(MKLIB)
- ocamlc_cmd = $(ocamlc)
- ocamlopt_cmd = $(ocamlopt)
-else
- FLEXLINK_ENV = \
- OCAML_FLEXLINK="$(ROOTDIR)/boot/ocamlrun $(ROOTDIR)/flexdll/flexlink.exe"
- CAMLOPT_CMD = $(FLEXLINK_ENV) $(CAMLOPT)
- OCAMLOPT_CMD = $(FLEXLINK_ENV) $(OCAMLOPT)
- MKLIB_CMD = $(FLEXLINK_ENV) $(MKLIB)
- ocamlc_cmd = $(FLEXLINK_ENV) $(ocamlc)
- ocamlopt_cmd = $(FLEXLINK_ENV) $(ocamlopt)
-endif
-
-OPTCOMPFLAGS=
-ifeq "$(FUNCTION_SECTIONS)" "true"
-OPTCOMPFLAGS += -function-sections
-endif
-# By default, request ocamllex to be quiet
-OCAMLLEX_FLAGS ?= -q
-
-# The rule to compile C files
-
-# This rule is similar to GNU make's implicit rule, except that it is more
-# general (it supports both .o and .obj)
-
-%.$(O): %.c
- $(CC) -c $(OC_CFLAGS) $(OC_CPPFLAGS) $(OUTPUTOBJ)$@ $<
# Whether the architecture has 64 bits
ARCH64=@arch64@
-# Endianess for this architecture
+# Endianness for this architecture
ENDIANNESS=@endianness@
### Name of architecture model for the native-code compiler.
# dynlink Dynamic linking (bytecode and native)
# (win32)unix Unix system calls
# str Regular expressions and high-level string processing
-# raw_spacetime_lib Parsing of spacetime traces
# systhreads Same as threads, requires POSIX threads
OTHERLIBRARIES=@otherlibraries@
# Needed for the "systhreads" package
PTHREAD_LINK=@pthread_link@
PTHREAD_CAML_LINK=$(addprefix -cclib ,$(PTHREAD_LINK))
+PTHREAD_CFLAGS=@PTHREAD_CFLAGS@
UNIX_OR_WIN32=@unix_or_win32@
UNIXLIB=@unixlib@
-BFD_CPPFLAGS=@bfd_cppflags@
-BFD_LDFLAGS=@bfd_ldflags@
-BFD_LDLIBS=@bfd_ldlibs@
INSTALL_SOURCE_ARTIFACTS=@install_source_artifacts@
OC_CFLAGS=@oc_cflags@
+CFLAGS?=@CFLAGS@
OC_CPPFLAGS=@oc_cppflags@
+CPPFLAGS?=@CPPFLAGS@
OCAMLC_CFLAGS=@ocamlc_cflags@
OCAMLC_CPPFLAGS=@ocamlc_cppflags@
WITH_OCAMLTEST=@ocamltest@
ASM_CFI_SUPPORTED=@asm_cfi_supported@
WITH_FRAME_POINTERS=@frame_pointers@
-WITH_SPACETIME=@spacetime@
-ENABLE_CALL_COUNTS=@call_counts@
WITH_PROFINFO=@profinfo@
PROFINFO_WIDTH=@profinfo_width@
-LIBUNWIND_AVAILABLE=@libunwind_available@
-LIBUNWIND_INCLUDE_FLAGS=@libunwind_include_flags@
-LIBUNWIND_LINK_FLAGS=@libunwind_link_flags@
WITH_FPIC=@fpic@
TARGET=@target@
HOST=@host@
DEFAULT_SAFE_STRING=@default_safe_string@
WINDOWS_UNICODE=@windows_unicode@
AFL_INSTRUMENT=@afl@
-MAX_TESTSUITE_DIR_RETRIES=@max_testsuite_dir_retries@
FLAT_FLOAT_ARRAY=@flat_float_array@
FUNCTION_SECTIONS=@function_sections@
AWK=@AWK@
STDLIB_MANPAGES=@stdlib_manpages@
-
+NAKED_POINTERS=@naked_pointers@
### Native command to build ocamlrun.exe
MERGEMANIFESTEXE=test ! -f $(1).manifest \
|| mt -nologo -outputresource:$(1) -manifest $(1).manifest \
&& rm -f $(1).manifest
- MKEXE_BOOT=$(CC) $(OC_CFLAGS) $(OUTPUTEXE)$(1) $(2) \
+ MKEXE_BOOT=$(CC) $(OC_CFLAGS) $(CFLAGS) $(OUTPUTEXE)$(1) $(2) \
/link /subsystem:console $(OC_LDFLAGS) && ($(MERGEMANIFESTEXE))
else
- MKEXE_BOOT=$(CC) $(OC_CFLAGS) $(OC_LDFLAGS) $(OUTPUTEXE)$(1) $(2)
+ MKEXE_BOOT=$(CC) $(OC_CFLAGS) $(CFLAGS) $(OC_LDFLAGS) $(OUTPUTEXE)$(1) $(2)
endif # ifeq "$(TOOLCHAIN)" "msvc"
# The following variables were defined only in the Windows-specific makefiles.
SORT=/usr/bin/sort
SET_LD_PATH=PATH="$(PATH):$(LD_PATH)"
FLEXLINK_CMD=flexlink
- MKEXE_ANSI=$(FLEXLINK) -exe
FLEXDLL_CHAIN=@flexdll_chain@
# FLEXLINK_FLAGS must be safe to insert in an OCaml string
# (see ocamlmklibconfig.ml in tools/Makefile)
--- /dev/null
+#**************************************************************************
+#* *
+#* OCaml *
+#* *
+#* Gabriel Scherer, projet Parsifal, INRIA Saclay *
+#* *
+#* 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. *
+#* *
+#**************************************************************************
+
+ifeq "$(MAKECMDGOALS)" ""
+MAKECMDGOALS += defaultentry
+endif
+
+CLEAN_TARGET_NAMES=clean partialclean distclean
+
+# Some special targets ('*clean' and 'configure') do not require configuration.
+# REQUIRES_CONFIGURATION is empty if only those targets are requested,
+# and non-empty if configuration is required.
+REQUIRES_CONFIGURATION := $(strip \
+ $(filter-out $(CLEAN_TARGET_NAMES) configure, $(MAKECMDGOALS)))
+
+ifneq "$(REQUIRES_CONFIGURATION)" ""
+include $(ROOTDIR)/Makefile.build_config
+endif
# variable. Note that for Windows we add Unix-syntax directory names in
# PATH, and Cygwin will translate it to Windows syntax.
--include $(TOPDIR)/Makefile.config
+# TOPDIR is legacy, our makefiles should use ROOTDIR now
+ROOTDIR=$(TOPDIR)
+include $(ROOTDIR)/Makefile.config_if_required
# Make sure USE_RUNTIME is defined
USE_RUNTIME ?=
CUSTOM =
endif
-OCAML=$(OCAMLRUN) $(OTOPDIR)/ocaml $(OCFLAGS) -noinit
+OCAML=$(OCAMLRUN) $(OTOPDIR)/ocaml$(EXE) $(OCFLAGS) -noinit
ifeq "$(FLEXLINK)" ""
FLEXLINK_PREFIX=
else
FLEXLINK_PREFIX=
else
EMPTY=
- FLEXLINK_PREFIX=OCAML_FLEXLINK="$(WINTOPDIR)/boot/ocamlrun \
+ FLEXLINK_PREFIX=OCAML_FLEXLINK="$(WINTOPDIR)/boot/ocamlrun$(EXE) \
$(WINTOPDIR)/flexdll/flexlink.exe" $(EMPTY)
endif
endif
-OCAMLC=$(FLEXLINK_PREFIX)$(OCAMLRUN) $(OTOPDIR)/ocamlc $(CUSTOM) $(OCFLAGS) \
- $(RUNTIME_VARIANT)
-OCAMLOPT=$(FLEXLINK_PREFIX)$(OCAMLRUN) $(OTOPDIR)/ocamlopt $(OCFLAGS) \
+OCAMLC=$(FLEXLINK_PREFIX)$(OCAMLRUN) $(OTOPDIR)/ocamlc$(EXE) \
+ $(CUSTOM) $(OCFLAGS) $(RUNTIME_VARIANT)
+OCAMLOPT=$(FLEXLINK_PREFIX)$(OCAMLRUN) $(OTOPDIR)/ocamlopt$(EXE) $(OCFLAGS) \
$(RUNTIME_VARIANT)
-OCAMLDOC=$(OCAMLRUN) $(OTOPDIR)/ocamldoc/ocamldoc
-OCAMLLEX=$(OCAMLRUN) $(OTOPDIR)/lex/ocamllex
-OCAMLMKLIB=$(FLEXLINK_PREFIX)$(OCAMLRUN) $(OTOPDIR)/tools/ocamlmklib \
+OCAMLDOC=$(OCAMLRUN) $(OTOPDIR)/ocamldoc/ocamldoc$(EXE)
+OCAMLLEX=$(OCAMLRUN) $(OTOPDIR)/lex/ocamllex$(EXE)
+OCAMLMKLIB=$(FLEXLINK_PREFIX)$(OCAMLRUN) $(OTOPDIR)/tools/ocamlmklib$(EXE) \
-ocamlc "$(OTOPDIR)/runtime/ocamlrun$(USE_RUNTIME)$(EXE) \
- $(OTOPDIR)/ocamlc $(OCFLAGS) $(RUNTIME_VARIANT)" \
+ $(OTOPDIR)/ocamlc$(EXE) $(OCFLAGS) $(RUNTIME_VARIANT)" \
-ocamlopt "$(OTOPDIR)/runtime/ocamlrun$(USE_RUNTIME)$(EXE) \
- $(OTOPDIR)/ocamlopt $(OCFLAGS) $(RUNTIME_VARIANT)"
+ $(OTOPDIR)/ocamlopt$(EXE) $(OCFLAGS) $(RUNTIME_VARIANT)"
OCAMLYACC=$(TOPDIR)/yacc/ocamlyacc$(EXE)
-DUMPOBJ=$(OCAMLRUN) $(OTOPDIR)/tools/dumpobj
-OBJINFO=$(OCAMLRUN) $(OTOPDIR)/tools/ocamlobjinfo
+DUMPOBJ=$(OCAMLRUN) $(OTOPDIR)/tools/dumpobj$(EXE)
+OBJINFO=$(OCAMLRUN) $(OTOPDIR)/tools/ocamlobjinfo$(EXE)
#FORTRAN_COMPILER=
#FORTRAN_LIBRARY=
+++ /dev/null
-OCaml 4.07.1 (4 October 2018)
------------------------------
-
-This release consists mostly of bug fixes. The most salient bugs were
-
-- MPR#7820, GPR#1897: a bug in Array.of_seq (new in 4.07)
- (Thierry Martinez, review by Nicolás Ojeda Bär)
-
-- MPR#7815, GPR#1896: crash in the major GC with the first-fit policy
- (Stephen Dolan and Damien Doligez, report by Joris Giovannangeli)
-
-- MPR#7821, GPR#1908: the compiler loads more cmi, which breaks some builds
- (Jérémie Dimino, review by Gabriel Scherer)
-
-- MPR#7833, GPR#1946: typechecking failure (regression) on large GADT matchings
- (Thomas Refis, report by Jerome Simeon, review by Jacques Garrigue)
-
-See the detailed list of fixes at (Changes#4.07.1).
-
-
-OCaml 4.07.0 (10 July 2018):
-----------------------------
-
-Some highlights of this release are:
-
-- The way the standard library modules are organized internally has
- changed (GPR#1010, by Jérémie Dimino):
-
- 1. the `List` module (for example) is now named `Stdlib__list`
- 2. a new Stdlib module contains a series of aliases
- such as `module List = Stdlib__list`
- 3. the `Stdlib` module is implicitly opened when type-checking OCaml
- programs (as `Pervasives` previously was), so that `Stdlib.List` can be
- accessed as just `List`, as before.
-
- This should be invisible to most users, although it is possible that
- some tools show the `Stdlib.` or `Stdlib__` prefixes in
- messages. (You might want to report these situations as usability
- bugs.) The change prevents standard library modules from conflicting
- with end-user filenames (please avoid `stdlib.ml` and the
- `Stdlib__` prefix); we may introduce new standard library modules in
- the future with less fear of breaking user code. In particular,
- `Float` (GPR#1638, by Nicolás Ojeda Bär) and `Seq` (GPR#1002, by
- Simon Cruanes) modules have now been added to the standard library.
-
-- The error messages caused by various typing errors have been improved
- to be easier to understand, in particular for beginners.
- (GPR#1505, GPR#1510, by Arthur Charguéreau and Armaël Guéneau)
-
- For example,
-
- # while 1 do () done;;
- ^
- Error: This expression has type int but
- an expression was expected of type bool
-
- now adds the extra explanation
-
- because it is in the condition of a while-loop
-
-- Effort has been made to reduce the compilation time of flambda
- programs, and the size of the produced `.cmx` files when using
- the -Oclassic optimisation level.
- (GPR#1401, GPR#1455, GPR#1627, GPR#1665, by Pierre Chambart, Xavier
- Clerc, Fuyong Quah, and Leo White)
-
-- The HTML manual has benefited from various style improvements
- and should look visually nicer than previous editions.
- (GPR#1741, GPR#1757, GPR#1767 by Charles Chamberlain and steinuil)
-
- The new version of the manual can be consulted at
- <http://caml.inria.fr/pub/docs/manual-ocaml-4.07/>; see the
- previous version for comparison at
- <http://caml.inria.fr/pub/docs/manual-ocaml-4.06/>.
-
-- Since 4.01, it is possible to select a variant constructor or
- record field from a sub-module that is not opened in the current
- scope, if type information is available at the point of use. This
- now also works for GADT constructors.
- (GPR#1648, by Thomas Refis and Leo White)
-
-- The GC should handle the accumulation of custom blocks in the minor
- heap better; this solves some memory-usage issues observed by code
- which allocates a lot of small custom blocks, typically small bigarrays
- (GPR#1476, by Alain Frsich)
-
-See also the detailed list of changes: (Changes#4.07.0).
-
-
-OCaml 4.06.1 (16 Feb 2018):
----------------------------
-
-This release consists mostly of bug fixes. The most salient bugs were
-
-- An incorrect compilation of pattern-matching in presence of
- extensible variant constructors (such as exceptions), that had been
- present for a long time.
- (GPR#1459, GPR#1538, by Luc Maranget, Thomas Refis and Gabriel Scherer)
-
-- An optimization of `not (x = y)` into `x <> y`, introduced in
- 4.06.0, is incorrect on floating-point numbers in the `nan`
- case. (GPR#1470, by Leo White)
-
-See the detailed list of fixes at (Changes#4.06.1).
-
-
-OCaml 4.06.0 (3 Nov 2017):
---------------------------
-
-- Strings (type `string`) are now immutable by default. In-place
- modification must use the type `bytes` of byte sequences, which is
- distinct from `string`. This corresponds to the `-safe-string`
- compile-time option, which was introduced in OCaml 4.02 in 2014, and
- which is now the default.
- (GPR#1252, by Damien Doligez)
-
-- Object types can now extend a previously-defined object type,
- as in `<t; a: int>`.
- (GPR#1118, by Runhang Li)
-
-- Destructive substitution over module signatures can now express more
- substitutions, such as `S with type M.t := type-expr` and `S with
- module M.N := path`.
- (GPR#792, by Valentin Gatien-Baron)
-
-- Users can now define operators that look like array indexing,
- e.g. `let ( .%() ) = List.nth in [0; 1; 2].%(1)`
- (GPR#1064, GPR#1392, by Florian Angeletti)
-
-- New escape `\u{XXXX}` in string literals, denoting the UTF-8
- encoding of the Unicode code point `XXXX`.
- (GPR#1232, by Daniel Bünzli)
-
-- Full Unicode support was added to the Windows runtime system. In
- particular, file names can now contain Unicode characters.
- (GPR#153, GPR#1200, GPR#1357, GPR#1362, GPR#1363, GPR#1369, GPR#1398,
- GPR#1446, GPR#1448, by ygrek and Nicolás Ojeda Bär)
-
-- An alternate register allocator based on linear scan can be selected
- with `ocamlopt -linscan`. It reduces compilation time compared with
- the default register allocator.
- (GPR#375, Marcell Fischbach and Benedikt Meurer)
-
-- The Num library for arbitrary-precision integer and rational
- arithmetic is no longer part of the core distribution and can be
- found as a separate OPAM package.
-
-See the detailed list of changes: (Changes#4.06.0).
-
-
-OCaml 4.05.0 (13 Jul 2017):
----------------------------
-
-Some highlights include:
-
-- Instrumentation support for fuzzing with afl-fuzz.
- (GPR#504, by Stephen Dolan)
-
-- The compilers now accept new `-args/-args0 <file>` command-line
- parameters to provide extra command-line arguments in a file. User
- programs may implement similar options using the new `Expand`
- constructor of the `Arg` module.
- (GPR#748, GPR#843, GPR#864, by Bernhard Schommer)
-
-- Many functions of the standard library that raise an exception now
- have an option-returning variable suffixed by `_opt` Typical
- examples of the new functions include:
-
- int_of_string_opt: string -> int option
- List.nth_opt: 'a list -> int -> 'a option
- Hashtbl.find_opt : ('a, 'b) t -> 'a -> 'b option
-
- (GPR#885, by Alain Frisch)
-
-- The security of the runtime system is now hardened by using `secure_getenv`
- to access environment variables whenever its possible, to avoid unplanned
- privilege-escalation when running setuid binaries.
- (GPR#1213, by Damien Doligez)
-
-See the detailed list of changes: (Changes#4.05.0).
|=====
-| Branch `trunk` | Branch `4.10` | Branch `4.09` | Branch `4.08` | Branch `4.07` | Branch `4.06` | Branch `4.05`
+| Branch `trunk` | Branch `4.11` | Branch `4.10` | Branch `4.09` | Branch `4.08` | Branch `4.07` | Branch `4.06` | Branch `4.05`
| image:https://travis-ci.org/ocaml/ocaml.svg?branch=trunk["TravisCI Build Status (trunk branch)",
link="https://travis-ci.org/ocaml/ocaml"]
image:https://ci.appveyor.com/api/projects/status/github/ocaml/ocaml?branch=trunk&svg=true["AppVeyor Build Status (trunk branch)",
link="https://ci.appveyor.com/project/avsm/ocaml"]
+| image:https://travis-ci.org/ocaml/ocaml.svg?branch=4.11["TravisCI Build Status (4.11 branch)",
+ link="https://travis-ci.org/ocaml/ocaml"]
+ image:https://ci.appveyor.com/api/projects/status/github/ocaml/ocaml?branch=4.11&svg=true["AppVeyor Build Status (4.11 branch)",
+ link="https://ci.appveyor.com/project/avsm/ocaml"]
| image:https://travis-ci.org/ocaml/ocaml.svg?branch=4.10["TravisCI Build Status (4.10 branch)",
link="https://travis-ci.org/ocaml/ocaml"]
image:https://ci.appveyor.com/api/projects/status/github/ocaml/ocaml?branch=4.10&svg=true["AppVeyor Build Status (4.10 branch)",
| x86 64 bits | Linux, macOS, Windows, FreeBSD | NetBSD, OpenBSD
| x86 32 bits | Linux, Windows | FreeBSD, NetBSD, OpenBSD
-| ARM 64 bits | Linux | FreeBSD
+| ARM 64 bits | Linux, macOS | FreeBSD
| ARM 32 bits | Linux | FreeBSD, NetBSD, OpenBSD
| Power 64 bits | Linux |
| Power 32 bits | | Linux
== Copyright
-All files marked "Copyright INRIA" in this distribution are copyright 1996,
-1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
-2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019
-Institut National de Recherche en Informatique et en Automatique (INRIA)
-and distributed under the conditions stated in file LICENSE.
+All files marked "Copyright INRIA" in this distribution are
+Copyright (C) 1996-2020 Institut National de Recherche en Informatique et
+en Automatique (INRIA) and distributed under the conditions stated in
+file LICENSE.
== Installation
For information on contributing to OCaml, see link:HACKING.adoc[] and
link:CONTRIBUTING.md[].
+
+== Separately maintained components
+
+Some libraries and tools which used to be part of the OCaml distribution are
+now maintained separately. Please use the issue trackers at their respective
+new homes:
+
+- https://github.com/ocaml/graphics/issues[The Graphics library] (removed in OCaml 4.09)
+- https://github.com/ocaml/num/issues[The Num library] (removed in OCaml 4.06)
+- https://github.com/ocaml/ocamlbuild/issues[The OCamlbuild tool] (removed in OCaml 4.03)
+- https://github.com/camlp4/camlp4/issues[The camlp4 tool] (removed in OCaml 4.02)
+- https://github.com/garrigue/labltk/issues[The LablTk library] (removed in OCaml 4.02)
+- https://github.com/ocaml/dbm/issues[The CamlDBM library] (removed in OCaml 4.00)
+- https://github.com/xavierleroy/ocamltopwin/issues[The OCamlWinTop Windows toplevel] (removed in OCaml 4.00)
-4.11.2
+4.12.0
# The version string is the first line of this file.
# It must be in the format described in stdlib/sys.mli
gcc __GNUC__ __GNUC_MINOR__
#elif defined(__xlc__) && defined(__xlC__)
xlc __xlC__ __xlC_ver__
+#elif defined(__SUNPRO_C)
+sunc __SUNPRO_C __SUNPRO_C
#else
unknown
#endif]
AC_MSG_RESULT([yes])],
[AC_MSG_RESULT([no])])])
+AC_DEFUN([OCAML_CC_SUPPORTS_TREE_VECTORIZE], [
+ AC_MSG_CHECKING(
+ [whether the C compiler supports __attribute__((optimize("tree-vectorize")))])
+ saved_CFLAGS="$CFLAGS"
+ CFLAGS="-Werror $CFLAGS"
+ AC_COMPILE_IFELSE(
+ [AC_LANG_SOURCE([
+ __attribute__((optimize("tree-vectorize"))) void f(void){}
+ int main() { f(); return 0; }
+ ])],
+ [AC_DEFINE([SUPPORTS_TREE_VECTORIZE])
+ AC_MSG_RESULT([yes])],
+ [AC_MSG_RESULT([no])])
+ CFLAGS="$saved_CFLAGS"
+])
+
AC_DEFUN([OCAML_CC_HAS_DEBUG_PREFIX_MAP], [
AC_MSG_CHECKING([whether the C compiler supports -fdebug-prefix-map])
saved_CFLAGS="$CFLAGS"
match op with
| Imove | Ispill | Ireload -> assert false (* treated specially *)
| Iconst_int _ | Iconst_float _ | Iconst_symbol _ -> Op_pure
- | Icall_ind _ | Icall_imm _ | Itailcall_ind _ | Itailcall_imm _
+ | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
| Iextcall _ -> assert false (* treated specially *)
| Istackoffset _ -> Op_other
| Iload(_,_) -> Op_load
| Istore(_,_,asg) -> Op_store asg
| Ialloc _ -> assert false (* treated specially *)
- | Iintop(Icheckbound _) -> Op_checkbound
+ | Iintop(Icheckbound) -> Op_checkbound
| Iintop _ -> Op_pure
- | Iintop_imm(Icheckbound _, _) -> Op_checkbound
+ | Iintop_imm(Icheckbound, _) -> Op_checkbound
| Iintop_imm(_, _) -> Op_pure
| Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
| Ifloatofint | Iintoffloat -> Op_pure
method private cse n i =
match i.desc with
- | Iend | Ireturn | Iop(Itailcall_ind _) | Iop(Itailcall_imm _)
+ | Iend | Ireturn | Iop(Itailcall_ind) | Iop(Itailcall_imm _)
| Iexit _ | Iraise _ ->
i
| Iop (Imove | Ispill | Ireload) ->
as to the argument reg. *)
let n1 = set_move n i.arg.(0) i.res.(0) in
{i with next = self#cse n1 i.next}
- | Iop (Icall_ind _ | Icall_imm _ | Iextcall _) ->
+ | Iop (Icall_ind | Icall_imm _ | Iextcall _) ->
(* For function calls, we should at least forget:
- equations involving memory loads, since the callee can
perform arbitrary memory stores;
(* these are base cases and have no logging *)
| Cconst_int _ | Cconst_natint _ | Cconst_float _
- | Cconst_symbol _ | Cconst_pointer _ | Cconst_natpointer _
- | Cblockheader _ | Cvar _ as c -> c
+ | Cconst_symbol _
+ | Cvar _ as c -> c
let instrument_function c dbg =
with_afl_logging c dbg
calls *)
with_afl_logging
(Csequence
- (Cop (Cextcall ("caml_setup_afl", typ_int, false, None),
+ (Cop (Cextcall ("caml_setup_afl", typ_int, [], false),
[Cconst_int (0, dbg ())],
dbg ()),
c))
and float_operation =
Ifloatadd | Ifloatsub | Ifloatmul | Ifloatdiv
-let spacetime_node_hole_pointer_is_live_before _specific_op = false
-
(* Sizes, endianness *)
let big_endian = false
let label s = sym (emit_label s)
-(* For Spacetime, keep track of code labels that have been emitted. *)
-let used_labels = ref Int.Set.empty
-
-let mark_used lbl =
- if Config.spacetime && not (Int.Set.mem lbl !used_labels) then begin
- used_labels := Int.Set.add lbl !used_labels
- end
-
let def_label ?typ s =
- mark_used s;
D.label ?typ (emit_label s)
let emit_Llabel fallthrough lbl =
(* Record live pointers at call points -- see Emitaux *)
-let record_frame_label ?label live dbg =
- let lbl =
- match label with
- | None -> new_label()
- | Some label -> label
- in
+let record_frame_label live dbg =
+ let lbl = new_label () in
let live_offset = ref [] in
Reg.Set.iter
(function
~live_offset:!live_offset dbg;
lbl
-let record_frame ?label live dbg =
- let lbl = record_frame_label ?label live dbg in
+let record_frame live dbg =
+ let lbl = record_frame_label live dbg in
def_label lbl
-(* Spacetime instrumentation *)
-
-let spacetime_before_uninstrumented_call ~node_ptr ~index =
- (* At the moment, [node_ptr] is pointing at the node for the current
- OCaml function. Get hold of the node itself and move the pointer
- forwards, saving it into the distinguished register. This is used
- for instrumentation of function calls (e.g. caml_call_gc and bounds
- check failures) not inserted until this stage of the compiler
- pipeline. *)
- I.mov node_ptr (reg Proc.loc_spacetime_node_hole);
- assert (index >= 2);
- I.add (int (index * 8)) (reg Proc.loc_spacetime_node_hole)
-
(* Record calls to the GC -- we've moved them out of the way *)
type gc_call =
{ gc_lbl: label; (* Entry label *)
gc_return_lbl: label; (* Where to branch after GC *)
gc_frame: label; (* Label of frame descriptor *)
- gc_spacetime : (X86_ast.arg * int) option;
- (* Spacetime node hole pointer and index *)
}
let call_gc_sites = ref ([] : gc_call list)
let emit_call_gc gc =
def_label gc.gc_lbl;
- begin match gc.gc_spacetime with
- | None -> assert (not Config.spacetime)
- | Some (node_ptr, index) ->
- assert Config.spacetime;
- spacetime_before_uninstrumented_call ~node_ptr ~index
- end;
emit_call "caml_call_gc";
def_label gc.gc_frame;
I.jmp (label gc.gc_return_lbl)
(* Record calls to caml_ml_array_bound_error.
- In -g mode, or when using Spacetime profiling, we maintain one call to
+ In -g mode we maintain one call to
caml_ml_array_bound_error per bound check site. Without -g, we can share
a single call. *)
type bound_error_call =
{ bd_lbl: label; (* Entry label *)
bd_frame: label; (* Label of frame descriptor *)
- bd_spacetime : (X86_ast.arg * int) option;
(* As for [gc_call]. *)
}
let bound_error_sites = ref ([] : bound_error_call list)
let bound_error_call = ref 0
-let bound_error_label ?label dbg ~spacetime =
- if !Clflags.debug || Config.spacetime then begin
+let bound_error_label dbg =
+ if !Clflags.debug then begin
let lbl_bound_error = new_label() in
- let lbl_frame = record_frame_label ?label Reg.Set.empty (Dbg_other dbg) in
+ let lbl_frame = record_frame_label Reg.Set.empty (Dbg_other dbg) in
bound_error_sites :=
- { bd_lbl = lbl_bound_error; bd_frame = lbl_frame;
- bd_spacetime = spacetime; } :: !bound_error_sites;
+ { bd_lbl = lbl_bound_error; bd_frame = lbl_frame; } :: !bound_error_sites;
lbl_bound_error
end else begin
if !bound_error_call = 0 then bound_error_call := new_label();
let emit_call_bound_error bd =
def_label bd.bd_lbl;
- begin match bd.bd_spacetime with
- | None -> ()
- | Some (node_ptr, index) ->
- spacetime_before_uninstrumented_call ~node_ptr ~index
- end;
emit_call "caml_ml_array_bound_error";
def_label bd.bd_frame
| Lop(Iconst_symbol s) ->
add_used_symbol s;
load_symbol_addr s (res i 0)
- | Lop(Icall_ind { label_after; }) ->
+ | Lop(Icall_ind) ->
I.call (arg i 0);
- record_frame i.live (Dbg_other i.dbg) ~label:label_after
- | Lop(Icall_imm { func; label_after; }) ->
+ record_frame i.live (Dbg_other i.dbg)
+ | Lop(Icall_imm { func; }) ->
add_used_symbol func;
emit_call func;
- record_frame i.live (Dbg_other i.dbg) ~label:label_after
- | Lop(Itailcall_ind { label_after; }) ->
- output_epilogue begin fun () ->
- I.jmp (arg i 0);
- if Config.spacetime then begin
- record_frame Reg.Set.empty (Dbg_other i.dbg) ~label:label_after
- end
- end
- | Lop(Itailcall_imm { func; label_after; }) ->
+ record_frame i.live (Dbg_other i.dbg)
+ | Lop(Itailcall_ind) ->
+ output_epilogue (fun () -> I.jmp (arg i 0))
+ | Lop(Itailcall_imm { func; }) ->
begin
if func = !function_name then
I.jmp (label !tailrec_entry_point)
emit_jump func
end
end
- end;
- if Config.spacetime then begin
- record_frame Reg.Set.empty (Dbg_other i.dbg) ~label:label_after
end
- | Lop(Iextcall { func; alloc; label_after; }) ->
+ | Lop(Iextcall { func; alloc; }) ->
add_used_symbol func;
if alloc then begin
load_symbol_addr func rax;
emit_call "caml_c_call";
- record_frame i.live (Dbg_other i.dbg) ~label:label_after;
+ record_frame i.live (Dbg_other i.dbg);
if system <> S_win64 then begin
(* TODO: investigate why such a diff.
This comes from:
I.mov (domain_field Domainstate.Domain_young_ptr) r15
end
end else begin
- emit_call func;
- if Config.spacetime then begin
- record_frame Reg.Set.empty (Dbg_other i.dbg) ~label:label_after
- end
+ emit_call func
end
| Lop(Istackoffset n) ->
if n < 0
| Double | Double_u ->
I.movsd (arg i 0) (addressing addr REAL8 i 1)
end
- | Lop(Ialloc { bytes = n; label_after_call_gc; spacetime_index; dbginfo }) ->
+ | Lop(Ialloc { bytes = n; dbginfo }) ->
assert (n <= (Config.max_young_wosize + 1) * Arch.size_addr);
if !fastcode_flag then begin
I.sub (int n) r15;
I.cmp (domain_field Domainstate.Domain_young_limit) r15;
let lbl_call_gc = new_label() in
let lbl_frame =
- record_frame_label ?label:label_after_call_gc i.live (Dbg_alloc dbginfo)
+ record_frame_label i.live (Dbg_alloc dbginfo)
in
I.jb (label lbl_call_gc);
let lbl_after_alloc = new_label() in
def_label lbl_after_alloc;
I.lea (mem64 NONE 8 R15) (res i 0);
- let gc_spacetime =
- if not Config.spacetime then None
- else Some (arg i 0, spacetime_index)
- in
call_gc_sites :=
{ gc_lbl = lbl_call_gc;
gc_return_lbl = lbl_after_alloc;
- gc_frame = lbl_frame;
- gc_spacetime; } :: !call_gc_sites
+ gc_frame = lbl_frame; } :: !call_gc_sites
end else begin
- if Config.spacetime then begin
- spacetime_before_uninstrumented_call ~node_ptr:(arg i 0)
- ~index:spacetime_index;
- end;
begin match n with
| 16 -> emit_call "caml_alloc1"
| 24 -> emit_call "caml_alloc2"
I.sub (int n) r15;
emit_call "caml_allocN"
end;
- let label =
- record_frame_label ?label:label_after_call_gc i.live
- (Dbg_alloc dbginfo)
- in
+ let label = record_frame_label i.live (Dbg_alloc dbginfo) in
def_label label;
I.lea (mem64 NONE 8 R15) (res i 0)
end
I.cmp (int n) (arg i 0);
I.set (cond cmp) al;
I.movzx al (res i 0)
- | Lop(Iintop (Icheckbound { label_after_error; spacetime_index; } )) ->
- let spacetime =
- if not Config.spacetime then None
- else Some (arg i 2, spacetime_index)
- in
- let lbl = bound_error_label ?label:label_after_error i.dbg ~spacetime in
+ | Lop(Iintop (Icheckbound)) ->
+ let lbl = bound_error_label i.dbg in
I.cmp (arg i 1) (arg i 0);
I.jbe (label lbl)
- | Lop(Iintop_imm(Icheckbound { label_after_error; spacetime_index; }, n)) ->
- let spacetime =
- if not Config.spacetime then None
- else Some (arg i 1, spacetime_index)
- in
- let lbl = bound_error_label ?label:label_after_error i.dbg ~spacetime in
+ | Lop(Iintop_imm(Icheckbound, n)) ->
+ let lbl = bound_error_label i.dbg in
I.cmp (int n) (arg i 0);
I.jbe (label lbl)
| Lop(Iintop(Idiv | Imod)) ->
cfi_adjust_cfa_offset (-8);
stack_offset := !stack_offset - 16
| Lraise k ->
- (* No Spacetime instrumentation is required for [caml_raise_exn] and
- [caml_reraise_exn]. The only function called that might affect the
- trie is [caml_stash_backtrace], and it does not. *)
begin match k with
| Lambda.Raise_regular ->
I.mov (int 0) (domain_field Domainstate.Domain_backtrace_pos);
reset_imp_table();
float_constants := [];
all_functions := [];
- used_labels := Int.Set.empty;
if system = S_win64 then begin
D.extrn "caml_call_gc" NEAR;
D.extrn "caml_c_call" NEAR;
if system = S_macosx then I.nop (); (* PR#4690 *)
()
-let emit_spacetime_shapes () =
- D.data ();
- D.align 8;
- emit_global_label "spacetime_shapes";
- List.iter (fun fundecl ->
- (* CR-someday mshinwell: some of this should be platform independent *)
- begin match fundecl.fun_spacetime_shape with
- | None -> ()
- | Some shape ->
- (* Instrumentation that refers to dead code may have been eliminated. *)
- match List.filter (fun (_, l) -> Int.Set.mem l !used_labels) shape with
- | [] -> ()
- | shape ->
- let funsym = emit_symbol fundecl.fun_name in
- D.comment ("Shape for " ^ funsym ^ ":");
- D.qword (ConstLabel funsym);
- List.iter (fun (part_of_shape, label) ->
- let tag =
- match part_of_shape with
- | Direct_call_point _ -> 1
- | Indirect_call_point -> 2
- | Allocation_point -> 3
- in
- D.qword (Const (Int64.of_int tag));
- D.qword (ConstLabel (emit_label label));
- begin match part_of_shape with
- | Direct_call_point { callee; } ->
- D.qword (ConstLabel (emit_symbol callee))
- | Indirect_call_point -> ()
- | Allocation_point -> ()
- end)
- shape;
- D.qword (Const 0L)
- end)
- !all_functions;
- D.qword (Const 0L);
- D.comment "End of Spacetime shapes."
-
let end_assembly() =
if !float_constants <> [] then begin
begin match system with
D.size frametable (ConstSub (ConstThis, ConstLabel frametable))
end;
- if Config.spacetime then begin
- emit_spacetime_shapes ()
- end;
-
if system = S_linux then
(* Mark stack as non-executable, PR#4564 *)
D.section [".note.GNU-stack"] (Some "") [ "%progbits" ];
let rdx = phys_reg 4
let r10 = phys_reg 10
let r11 = phys_reg 11
-let r13 = phys_reg 9
let rbp = phys_reg 12
let rxmm15 = phys_reg 115
let float = ref first_float in
let ofs = ref 0 in
for i = 0 to Array.length arg - 1 do
- match arg.(i).typ with
+ match arg.(i) with
| Val | Int | Addr as ty ->
if !int <= last_int then begin
loc.(i) <- phys_reg !int;
let outgoing ofs = Outgoing ofs
let not_supported _ofs = fatal_error "Proc.loc_results: cannot call"
-let max_int_args_in_regs () =
- if Config.spacetime then 9 else 10
-
let loc_arguments arg =
- calling_conventions 0 ((max_int_args_in_regs ()) - 1) 100 109 outgoing arg
+ calling_conventions 0 9 100 109 outgoing arg
let loc_parameters arg =
let (loc, _ofs) =
- calling_conventions 0 ((max_int_args_in_regs ()) - 1) 100 109 incoming arg
+ calling_conventions 0 9 100 109 incoming arg
in
loc
let loc_results res =
let (loc, _ofs) = calling_conventions 0 0 100 100 not_supported res in loc
-let loc_spacetime_node_hole = r13
-
(* C calling conventions under Unix:
first integer args in rdi, rsi, rdx, rcx, r8, r9
first float args in xmm0 ... xmm7
let reg = ref 0
and ofs = ref 32 in
for i = 0 to Array.length arg - 1 do
- match arg.(i).typ with
+ match arg.(i) with
| Val | Int | Addr as ty ->
if !reg < 4 then begin
loc.(i) <- phys_reg win64_int_external_arguments.(!reg);
done;
(loc, Misc.align !ofs 16) (* keep stack 16-aligned *)
-let loc_external_arguments arg =
- let arg =
- Array.map (fun regs -> assert (Array.length regs = 1); regs.(0)) arg
- in
- let loc, alignment =
- if win64 then win64_loc_external_arguments arg
+let loc_external_arguments ty_args =
+ let arg = Cmm.machtype_of_exttype_list ty_args in
+ let loc, stack_ofs =
+ if win64
+ then win64_loc_external_arguments arg
else unix_loc_external_arguments arg
in
- Array.map (fun reg -> [|reg|]) loc, alignment
+ Array.map (fun reg -> [|reg|]) loc, stack_ofs
let loc_exn_bucket = rax
100;101;102;103;104;105;106;107;
108;109;110;111;112;113;114;115])
-let destroyed_by_spacetime_at_alloc =
- if Config.spacetime then
- [| loc_spacetime_node_hole |]
- else
- [| |]
-
let destroyed_at_alloc =
- let regs =
- if X86_proc.use_plt then
- destroyed_by_plt_stub
- else
- [| r11 |]
- in
- Array.concat [regs; destroyed_by_spacetime_at_alloc]
+ if X86_proc.use_plt then
+ destroyed_by_plt_stub
+ else
+ [| r11 |]
let destroyed_at_oper = function
- Iop(Icall_ind _ | Icall_imm _ | Iextcall { alloc = true; }) ->
+ Iop(Icall_ind | Icall_imm _ | Iextcall { alloc = true; }) ->
all_phys_regs
| Iop(Iextcall { alloc = false; }) -> destroyed_at_c_call
| Iop(Iintop(Idiv | Imod)) | Iop(Iintop_imm((Idiv | Imod), _))
| Iop(Ialloc _) -> destroyed_at_alloc
| Iop(Iintop(Imulh | Icomp _) | Iintop_imm((Icomp _), _))
-> [| rax |]
- | Iop (Iintop (Icheckbound _)) when Config.spacetime ->
- [| loc_spacetime_node_hole |]
- | Iop (Iintop_imm(Icheckbound _, _)) when Config.spacetime ->
- [| loc_spacetime_node_hole |]
| Iswitch(_, _) -> [| rax; rdx |]
| Itrywith _ -> [| r11 |]
| _ ->
registers). *)
let op_is_pure = function
- | Icall_ind _ | Icall_imm _ | Itailcall_ind _ | Itailcall_imm _
+ | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
| Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
- | Iintop(Icheckbound _) | Iintop_imm(Icheckbound _, _) -> false
+ | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _) -> false
| Ispecific(Ilea _|Isextend32|Izextend32) -> true
| Ispecific _ -> false
| _ -> true
method! reload_operation op arg res =
match op with
- | Iintop(Iadd|Isub|Iand|Ior|Ixor|Icomp _|Icheckbound _) ->
+ | Iintop(Iadd|Isub|Iand|Ior|Ixor|Icomp _|Icheckbound) ->
(* One of the two arguments can reside in the stack, but not both *)
if stackp arg.(0) && stackp arg.(1)
then ([|arg.(0); self#makereg arg.(1)|], res)
[ "sqrt"; "caml_bswap16_direct"; "caml_int32_direct_bswap";
"caml_int64_direct_bswap"; "caml_nativeint_direct_bswap" ]
+let is_immediate n = n <= 0x7FFF_FFFF && n >= -0x8000_0000
+
+let is_immediate_natint n = n <= 0x7FFF_FFFFn && n >= -0x8000_0000n
+
(* The selector class *)
class selector = object (self)
-inherit Spacetime_profiling.instruction_selection as super
+inherit Selectgen.selector_generic as super
-method is_immediate n = n <= 0x7FFF_FFFF && n >= (-1-0x7FFF_FFFF)
- (* -1-.... : hack so that this can be compiled on 32-bit
- (cf 'make check_all_arches') *)
+method! is_immediate op n =
+ match op with
+ | Iadd | Isub | Imul | Iand | Ior | Ixor | Icomp _ | Icheckbound ->
+ is_immediate n
+ | _ ->
+ super#is_immediate op n
-method is_immediate_natint n = n <= 0x7FFFFFFFn && n >= -0x80000000n
+method is_immediate_test _cmp n = is_immediate n
method! is_simple_expr e =
match e with
method select_addressing _chunk exp =
let (a, d) = select_addr exp in
(* PR#4625: displacement must be a signed 32-bit immediate *)
- if not (self # is_immediate d)
+ if not (is_immediate d)
then (Iindexed 0, exp)
else match a with
| Asymbol s ->
method! select_store is_assign addr exp =
match exp with
- Cconst_int (n, _dbg) when self#is_immediate n ->
- (Ispecific(Istore_int(Nativeint.of_int n, addr, is_assign)), Ctuple [])
- | (Cconst_natint (n, _dbg)) when self#is_immediate_natint n ->
- (Ispecific(Istore_int(n, addr, is_assign)), Ctuple [])
- | (Cblockheader(n, _dbg))
- when self#is_immediate_natint n && not Config.spacetime ->
- (Ispecific(Istore_int(n, addr, is_assign)), Ctuple [])
- | Cconst_pointer (n, _dbg) when self#is_immediate n ->
+ Cconst_int (n, _dbg) when is_immediate n ->
(Ispecific(Istore_int(Nativeint.of_int n, addr, is_assign)), Ctuple [])
- | Cconst_natpointer (n, _dbg) when self#is_immediate_natint n ->
+ | (Cconst_natint (n, _dbg)) when is_immediate_natint n ->
(Ispecific(Istore_int(n, addr, is_assign)), Ctuple [])
| _ ->
super#select_store is_assign addr exp
self#select_floatarith true Imulf Ifloatmul args
| Cdivf ->
self#select_floatarith false Idivf Ifloatdiv args
- | Cextcall("sqrt", _, false, _) ->
+ | Cextcall("sqrt", _, _, false) ->
begin match args with
[Cop(Cload ((Double|Double_u as chunk), _), [loc], _dbg)] ->
let (addr, arg) = self#select_addressing chunk loc in
| Cstore ((Word_int|Word_val as chunk), _init) ->
begin match args with
[loc; Cop(Caddi, [Cop(Cload _, [loc'], _); Cconst_int (n, _dbg)], _)]
- when loc = loc' && self#is_immediate n ->
+ when loc = loc' && is_immediate n ->
let (addr, arg) = self#select_addressing chunk loc in
(Ispecific(Ioffset_loc(n, addr)), [arg])
| _ ->
| Cextcall("caml_int64_direct_bswap", _, _, _)
| Cextcall("caml_nativeint_direct_bswap", _, _, _) ->
(Ispecific (Ibswap 64), args)
- (* AMD64 does not support immediate operands for multiply high signed *)
- | Cmulhi ->
- (Iintop Imulh, args)
+ (* Recognize sign extension *)
| Casr ->
begin match args with
- (* Recognize sign extension *)
[Cop(Clsl, [k; Cconst_int (32, _)], _); Cconst_int (32, _)] ->
(Ispecific Isextend32, [k])
| _ -> super#select_operation op args dbg
| Ishiftlogicalright
| Ishiftarithmeticright
-let spacetime_node_hole_pointer_is_live_before _specific_op = false
-
(* Sizes, endianness *)
let big_endian = false
(* Record live pointers at call points *)
-let record_frame_label ?label live dbg =
- let lbl =
- match label with
- | None -> new_label()
- | Some label -> label
- in
+let record_frame_label live dbg =
+ let lbl = new_label () in
let live_offset = ref [] in
Reg.Set.iter
(function
~live_offset:!live_offset dbg;
lbl
-let record_frame ?label live dbg =
- let lbl = record_frame_label ?label live dbg in `{emit_label lbl}:`
+let record_frame live dbg =
+ let lbl = record_frame_label live dbg in `{emit_label lbl}:`
(* Record calls to the GC -- we've moved them out of the way *)
let bound_error_sites = ref ([] : bound_error_call list)
-let bound_error_label ?label dbg =
+let bound_error_label dbg =
if !Clflags.debug || !bound_error_sites = [] then begin
let lbl_bound_error = new_label() in
- let lbl_frame = record_frame_label ?label Reg.Set.empty (Dbg_other dbg) in
+ let lbl_frame = record_frame_label Reg.Set.empty (Dbg_other dbg) in
bound_error_sites :=
{ bd_lbl = lbl_bound_error;
bd_frame_lbl = lbl_frame } :: !bound_error_sites;
end; 1
| Lop(Iconst_symbol s) ->
emit_load_symbol_addr i.res.(0) s
- | Lop(Icall_ind { label_after; }) ->
+ | Lop(Icall_ind) ->
if !arch >= ARMv5 then begin
` blx {emit_reg i.arg.(0)}\n`;
- `{record_frame i.live (Dbg_other i.dbg) ~label:label_after}\n`; 1
+ `{record_frame i.live (Dbg_other i.dbg)}\n`; 1
end else begin
` mov lr, pc\n`;
` bx {emit_reg i.arg.(0)}\n`;
- `{record_frame i.live (Dbg_other i.dbg) ~label:label_after}\n`; 2
+ `{record_frame i.live (Dbg_other i.dbg)}\n`; 2
end
- | Lop(Icall_imm { func; label_after; }) ->
+ | Lop(Icall_imm { func; }) ->
` {emit_call func}\n`;
- `{record_frame i.live (Dbg_other i.dbg) ~label:label_after}\n`; 1
- | Lop(Itailcall_ind { label_after = _; }) ->
+ `{record_frame i.live (Dbg_other i.dbg)}\n`; 1
+ | Lop(Itailcall_ind) ->
output_epilogue begin fun () ->
if !contains_calls then
` ldr lr, [sp, #{emit_int (-4)}]\n`;
` bx {emit_reg i.arg.(0)}\n`; 2
end
- | Lop(Itailcall_imm { func; label_after = _; }) ->
+ | Lop(Itailcall_imm { func; }) ->
if func = !function_name then begin
` b {emit_label !tailrec_entry_point}\n`; 1
end else begin
end
| Lop(Iextcall { func; alloc = false; }) ->
` {emit_call func}\n`; 1
- | Lop(Iextcall { func; alloc = true; label_after; }) ->
+ | Lop(Iextcall { func; alloc = true; }) ->
let ninstr = emit_load_symbol_addr (phys_reg 7 (* r7 *)) func in
` {emit_call "caml_c_call"}\n`;
- `{record_frame i.live (Dbg_other i.dbg) ~label:label_after}\n`;
+ `{record_frame i.live (Dbg_other i.dbg)}\n`;
1 + ninstr
| Lop(Istackoffset n) ->
assert (n mod 8 = 0);
| Double_u -> "fstd"
| _ (* 32-bit quantities *) -> "str" in
` {emit_string instr} {emit_reg r}, {emit_addressing addr i.arg 1}\n`; 1
- | Lop(Ialloc { bytes = n; label_after_call_gc; dbginfo }) ->
+ | Lop(Ialloc { bytes = n; dbginfo }) ->
let lbl_frame =
- record_frame_label i.live (Dbg_alloc dbginfo) ?label:label_after_call_gc
+ record_frame_label i.live (Dbg_alloc dbginfo)
in
if !fastcode_flag then begin
let ninstr = decompose_intconst
| Lop(Iintop_imm(Icomp cmp, n)) ->
` cmp {emit_reg i.arg.(0)}, #{emit_int n}\n`;
1 + emit_set_condition cmp i.res.(0)
- | Lop(Iintop (Icheckbound { label_after_error; } )) ->
- let lbl = bound_error_label ?label:label_after_error i.dbg in
+ | Lop(Iintop (Icheckbound)) ->
+ let lbl = bound_error_label i.dbg in
` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
` bls {emit_label lbl}\n`; 2
- | Lop(Iintop_imm(Icheckbound { label_after_error; }, n)) ->
- let lbl = bound_error_label ?label:label_after_error i.dbg in
+ | Lop(Iintop_imm(Icheckbound, n)) ->
+ let lbl = bound_error_label i.dbg in
` cmp {emit_reg i.arg.(0)}, #{emit_int n}\n`;
` bls {emit_label lbl}\n`; 2
| Lop(Ispecific(Ishiftcheckbound(shiftop, n))) ->
let stack_slot slot ty =
Reg.at_location ty (Stack slot)
-let loc_spacetime_node_hole = Reg.dummy (* Spacetime unsupported *)
-
(* Calling conventions *)
+let loc_int last_int make_stack int ofs =
+ if !int <= last_int then begin
+ let l = phys_reg !int in
+ incr int; l
+ end else begin
+ let l = stack_slot (make_stack !ofs) Int in
+ ofs := !ofs + size_int; l
+ end
+
+let loc_float last_float make_stack float ofs =
+ assert (abi = EABI_HF);
+ assert (!fpu >= VFPv2);
+ if !float <= last_float then begin
+ let l = phys_reg !float in
+ incr float; l
+ end else begin
+ ofs := Misc.align !ofs size_float;
+ let l = stack_slot (make_stack !ofs) Float in
+ ofs := !ofs + size_float; l
+ end
+
+let loc_int_pair last_int make_stack int ofs =
+ (* 64-bit quantities split across two registers must either be in a
+ consecutive pair of registers where the lowest numbered is an
+ even-numbered register; or in a stack slot that is 8-byte aligned. *)
+ int := Misc.align !int 2;
+ if !int <= last_int - 1 then begin
+ let reg_lower = phys_reg !int in
+ let reg_upper = phys_reg (1 + !int) in
+ int := !int + 2;
+ [| reg_lower; reg_upper |]
+ end else begin
+ let size_int64 = size_int * 2 in
+ ofs := Misc.align !ofs size_int64;
+ let stack_lower = stack_slot (make_stack !ofs) Int in
+ let stack_upper = stack_slot (make_stack (size_int + !ofs)) Int in
+ ofs := !ofs + size_int64;
+ [| stack_lower; stack_upper |]
+ end
+
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 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
for i = 0 to Array.length arg - 1 do
match arg.(i) with
- | [| arg |] ->
- begin match arg.typ with
- | Val | Int | Addr as ty ->
- if !int <= last_int then begin
- loc.(i) <- [| phys_reg !int |];
- incr int
- end else begin
- loc.(i) <- [| stack_slot (make_stack !ofs) ty |];
- ofs := !ofs + size_int
- end
- | Float ->
- assert (abi = EABI_HF);
- assert (!fpu >= VFPv2);
- if !float <= last_float then begin
- loc.(i) <- [| phys_reg !float |];
- incr float
- end else begin
- ofs := Misc.align !ofs size_float;
- loc.(i) <- [| stack_slot (make_stack !ofs) Float |];
- ofs := !ofs + size_float
- end
- end
- | [| arg1; arg2 |] ->
- (* Passing of 64-bit quantities to external functions. *)
- begin match arg1.typ, arg2.typ with
- | Int, Int ->
- (* 64-bit quantities split across two registers must either be in a
- consecutive pair of registers where the lowest numbered is an
- even-numbered register; or in a stack slot that is 8-byte
- aligned. *)
- int := Misc.align !int 2;
- if !int <= last_int - 1 then begin
- let reg_lower = phys_reg !int in
- let reg_upper = phys_reg (1 + !int) in
- loc.(i) <- [| reg_lower; reg_upper |];
- int := !int + 2
- end else begin
- let size_int64 = size_int * 2 in
- ofs := Misc.align !ofs size_int64;
- let stack_lower = stack_slot (make_stack !ofs) Int in
- let stack_upper = stack_slot (make_stack (size_int + !ofs)) Int in
- loc.(i) <- [| stack_lower; stack_upper |];
- ofs := !ofs + size_int64
- end
- | _, _ ->
- let f = function Int -> "I" | Addr -> "A" | Val -> "V" | Float -> "F" in
- fatal_error (Printf.sprintf "Proc.calling_conventions: bad register \
- type(s) for multi-register argument: %s, %s"
- (f arg1.typ) (f arg2.typ))
- end
- | _ ->
- fatal_error "Proc.calling_conventions: bad number of registers for \
- multi-register argument"
+ | Val | Int | Addr ->
+ loc.(i) <- loc_int last_int make_stack int ofs
+ | Float ->
+ loc.(i) <- loc_float last_float make_stack float ofs
done;
(loc, Misc.align !ofs 8) (* keep stack 8-aligned *)
let max_arguments_for_tailcalls = 8
-let single_regs arg = Array.map (fun arg -> [| arg |]) arg
-let ensure_single_regs res =
- Array.map (function
- | [| res |] -> res
- | _ -> failwith "Proc.ensure_single_regs")
- res
-
let loc_arguments arg =
- let (loc, alignment) =
- calling_conventions 0 7 100 115 outgoing (single_regs arg)
- in
- ensure_single_regs loc, alignment
+ calling_conventions 0 7 100 115 outgoing arg
+
let loc_parameters arg =
- let (loc, _) = calling_conventions 0 7 100 115 incoming (single_regs arg) in
- ensure_single_regs loc
+ let (loc, _) = calling_conventions 0 7 100 115 incoming arg in loc
+
let loc_results res =
- let (loc, _) =
- calling_conventions 0 7 100 115 not_supported (single_regs res)
- in
- ensure_single_regs loc
+ let (loc, _) = calling_conventions 0 7 100 115 not_supported res in loc
(* C calling convention:
first integer args in r0...r3
+ first 64-bit integer args in r0-r1, r2-r3
first float args in d0...d7 (EABI+VFP)
+ first float args in r0-r1, r2-r3 (soft FP)
remaining args on stack.
- Return values in r0...r1 or d0. *)
+ Return values in r0, r0-r1, or d0. *)
+
+let external_calling_conventions first_int last_int first_float last_float
+ make_stack ty_args =
+ let loc = Array.make (List.length ty_args) [| Reg.dummy |] in
+ let int = ref first_int in
+ let float = ref first_float in
+ let ofs = ref 0 in
+ List.iteri
+ (fun i ty_arg ->
+ match ty_arg with
+ | XInt | XInt32 ->
+ loc.(i) <- [| loc_int last_int make_stack int ofs |]
+ | XInt64 ->
+ loc.(i) <- loc_int_pair last_int make_stack int ofs
+ | XFloat ->
+ loc.(i) <-
+ (if abi = EABI_HF
+ then [| loc_float last_float make_stack float ofs |]
+ else loc_int_pair last_int make_stack int ofs))
+ ty_args;
+ (loc, Misc.align !ofs 8) (* keep stack 8-aligned *)
+
+let loc_external_arguments ty_args =
+ external_calling_conventions 0 3 100 107 outgoing ty_args
-let loc_external_arguments arg =
- calling_conventions 0 3 100 107 outgoing arg
let loc_external_results res =
- let (loc, _) =
- calling_conventions 0 1 100 100 not_supported (single_regs res)
- in
- ensure_single_regs loc
+ let (loc, _) = calling_conventions 0 1 100 100 not_supported res
+ in loc
let loc_exn_bucket = phys_reg 0
124;125;126;127;128;129;130;131]))
let destroyed_at_oper = function
- Iop(Icall_ind _ | Icall_imm _)
+ Iop(Icall_ind | Icall_imm _)
| Iop(Iextcall { alloc = true; _ }) ->
all_phys_regs
| Iop(Iextcall { alloc = false; _}) ->
registers). *)
let op_is_pure = function
- | Icall_ind _ | Icall_imm _ | Itailcall_ind _ | Itailcall_imm _
+ | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
| Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
- | Iintop(Icheckbound _) | Iintop_imm(Icheckbound _, _)
+ | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _)
| Ispecific(Ishiftcheckbound _) -> false
| _ -> true
| Iintop(Ilsl | Ilsr | Iasr) -> 2
| Iintop(Icomp _)
| Iintop_imm(Icomp _, _) -> 3
- | Iintop(Icheckbound _)
- | Iintop_imm(Icheckbound _, _) -> 2
+ | Iintop(Icheckbound)
+ | Iintop_imm(Icheckbound, _) -> 2
| Ispecific(Ishiftcheckbound _) -> 3
| Iintop(Imul | Imulh)
| Ispecific(Imuladd | Imulsub | Imulhadd) -> 2
(arg', res)
(* We use __aeabi_idivmod for Cmodi only, and hence we care only
for the remainder in r1, so fix up the destination register. *)
- | Iextcall { func = "__aeabi_idivmod"; alloc = false; } ->
+ | Iextcall { func = "__aeabi_idivmod"; _ } ->
(arg, [|r1|])
(* Other instructions are regular *)
| _ -> raise Use_default
tyv
end)
-method is_immediate n =
- is_immediate (Int32.of_int n)
+method! is_immediate op n =
+ match op with
+ | Iadd | Isub | Iand | Ior | Ixor | Icomp _ | Icheckbound ->
+ Arch.is_immediate (Int32.of_int n)
+ | _ ->
+ super#is_immediate op n
+
+method is_immediate_test _op n =
+ Arch.is_immediate (Int32.of_int n)
method! is_simple_expr = function
(* inlined floating-point ops are simple if their arguments are *)
| Cop(Cextcall("caml_bswap16_direct", _, _, _), args, _)
when !arch >= ARMv6T2 ->
List.for_all self#is_simple_expr args
- | Cop(Cextcall("caml_int32_direct_bswap",_,_,_), args, _)
+ | Cop(Cextcall("caml_int32_direct_bswap", _, _, _), args, _)
when !arch >= ARMv6 ->
List.for_all self#is_simple_expr args
| e -> super#is_simple_expr e
| Cop(Cextcall("caml_bswap16_direct", _, _, _), args, _)
when !arch >= ARMv6T2 ->
Selectgen.Effect_and_coeffect.join_list_map args self#effects_of
- | Cop(Cextcall("caml_int32_direct_bswap",_,_,_), args, _)
+ | Cop(Cextcall("caml_int32_direct_bswap",_ ,_ , _), args, _)
when !arch >= ARMv6 ->
Selectgen.Effect_and_coeffect.join_list_map args self#effects_of
| e -> super#effects_of e
| op_args -> op_args
end
-method private iextcall (func, alloc) =
- Iextcall { func; alloc; label_after = Cmm.new_label (); }
+method private iextcall func ty_res ty_args =
+ Iextcall { func; ty_res; ty_args; alloc = false; }
method! select_operation op args dbg =
match (op, args) with
- (* Recognize special shift arithmetic *)
- ((Caddv | Cadda | Caddi), [arg; Cconst_int (n, _)])
- when n < 0 && self#is_immediate (-n) ->
+ (* Recognize special forms of add immediate / sub immediate *)
+ | ((Caddv | Cadda | Caddi), [arg; Cconst_int (n, _)])
+ when n < 0 && Arch.is_immediate (Int32.of_int (-n)) ->
(Iintop_imm(Isub, -n), [arg])
- | ((Caddv | Cadda | Caddi as op), args) ->
- self#select_shift_arith op dbg Ishiftadd Ishiftadd args
| (Csubi, [arg; Cconst_int (n, _)])
- when n < 0 && self#is_immediate (-n) ->
+ when n < 0 && Arch.is_immediate (Int32.of_int (-n)) ->
(Iintop_imm(Iadd, -n), [arg])
| (Csubi, [Cconst_int (n, _); arg])
- when self#is_immediate n ->
+ when Arch.is_immediate (Int32.of_int n) ->
(Ispecific(Irevsubimm n), [arg])
+ (* Recognize special shift arithmetic *)
+ | ((Caddv | Cadda | Caddi as op), args) ->
+ self#select_shift_arith op dbg Ishiftadd Ishiftadd args
| (Csubi as op, args) ->
self#select_shift_arith op dbg Ishiftsub Ishiftsubrev args
| (Cand as op, args) ->
[Cop(Clsl | Clsr | Casr as op, [arg1; Cconst_int (n, _)], _); arg2])
when n > 0 && n < 32 ->
(Ispecific(Ishiftcheckbound(select_shiftop op, n)), [arg1; arg2])
- (* ARM does not support immediate operands for multiplication *)
- | (Cmuli, args) ->
- (Iintop Imul, args)
- | (Cmulhi, args) ->
- (Iintop Imulh, args)
(* Turn integer division/modulus into runtime ABI calls *)
| (Cdivi, args) ->
- (self#iextcall("__aeabi_idiv", false), args)
+ (self#iextcall "__aeabi_idiv" typ_int [], args)
| (Cmodi, args) ->
(* See above for fix up of return register *)
- (self#iextcall("__aeabi_idivmod", false), args)
+ (self#iextcall "__aeabi_idivmod" typ_int [], args)
(* Recognize 16-bit bswap instruction (ARMv6T2 because we need movt) *)
| (Cextcall("caml_bswap16_direct", _, _, _), args) when !arch >= ARMv6T2 ->
(Ispecific(Ibswap 16), args)
method private select_operation_softfp op args dbg =
match (op, args) with
(* Turn floating-point operations into runtime ABI calls *)
- | (Caddf, args) -> (self#iextcall("__aeabi_dadd", false), args)
- | (Csubf, args) -> (self#iextcall("__aeabi_dsub", false), args)
- | (Cmulf, args) -> (self#iextcall("__aeabi_dmul", false), args)
- | (Cdivf, args) -> (self#iextcall("__aeabi_ddiv", false), args)
- | (Cfloatofint, args) -> (self#iextcall("__aeabi_i2d", false), args)
- | (Cintoffloat, args) -> (self#iextcall("__aeabi_d2iz", false), args)
+ | (Caddf, args) ->
+ (self#iextcall "__aeabi_dadd" typ_float [XFloat;XFloat], args)
+ | (Csubf, args) ->
+ (self#iextcall "__aeabi_dsub" typ_float [XFloat;XFloat], args)
+ | (Cmulf, args) ->
+ (self#iextcall "__aeabi_dmul" typ_float [XFloat;XFloat], args)
+ | (Cdivf, args) ->
+ (self#iextcall "__aeabi_ddiv" typ_float [XFloat;XFloat], args)
+ | (Cfloatofint, args) ->
+ (self#iextcall "__aeabi_i2d" typ_float [XInt], args)
+ | (Cintoffloat, args) ->
+ (self#iextcall "__aeabi_d2iz" typ_int [XFloat], args)
| (Ccmpf comp, args) ->
let comp, func =
match comp with
| CFnge -> Ceq, "__aeabi_dcmpge"
in
(Iintop_imm(Icomp(Iunsigned comp), 0),
- [Cop(Cextcall(func, typ_int, false, None), args, dbg)])
+ [Cop(Cextcall(func, typ_int, [XFloat;XFloat], false),
+ args, dbg)])
(* Add coercions around loads and stores of 32-bit floats *)
| (Cload (Single, mut), args) ->
- (self#iextcall("__aeabi_f2d", false),
+ (self#iextcall "__aeabi_f2d" typ_float [XInt],
[Cop(Cload (Word_int, mut), args, dbg)])
| (Cstore (Single, init), [arg1; arg2]) ->
let arg2' =
- Cop(Cextcall("__aeabi_d2f", typ_int, false, None), [arg2], dbg) in
+ Cop(Cextcall("__aeabi_d2f", typ_int, [XFloat], false),
+ [arg2], dbg) in
self#select_operation (Cstore (Word_int, init)) [arg1; arg2'] dbg
(* Other operations are regular *)
| (op, args) -> super#select_operation op args dbg
| (Csubf, [Cop(Cmulf, args, _); arg]) ->
(Ispecific Imulsubf, arg :: args)
(* Recognize floating-point square root *)
- | (Cextcall("sqrt", _, false, _), args) ->
+ | (Cextcall("sqrt", _, _, false), args) ->
(Ispecific Isqrtf, args)
(* Other operations are regular *)
| (op, args) -> super#select_operation op args dbg
_ARM Architecture Reference Manual, ARMv8_, restricted to the AArch64 subset.
* Application binary interface:
_Procedure Call Standard for the ARM 64-bit Architecture (AArch64)_
+ _Apple ARM64 Function Calling Conventions_
open Format
+let macosx = (Config.system = "macosx")
+
+(* Machine-specific command-line options *)
+
let command_line_options = []
(* Addressing modes *)
(* Do not introduce a dependency to Cmm *)
type specific_operation =
- | Ifar_alloc of { bytes : int; label_after_call_gc : cmm_label option;
- dbginfo : Debuginfo.alloc_dbginfo }
- | Ifar_intop_checkbound of { label_after_error : cmm_label option; }
- | Ifar_intop_imm_checkbound of
- { bound : int; label_after_error : cmm_label option; }
+ | Ifar_alloc of { bytes : int; dbginfo : Debuginfo.alloc_dbginfo }
+ | Ifar_intop_checkbound
+ | Ifar_intop_imm_checkbound of { bound : int; }
| Ishiftarith of arith_operation * int
- | Ishiftcheckbound of { shift : int; label_after_error : cmm_label option; }
- | Ifar_shiftcheckbound of
- { shift : int; label_after_error : cmm_label option; }
+ | Ishiftcheckbound of { shift : int; }
+ | Ifar_shiftcheckbound of { shift : int; }
| Imuladd (* multiply and add *)
| Imulsub (* multiply and subtract *)
| Inegmulf (* floating-point negate and multiply *)
| Inegmulsubf (* floating-point negate, multiply and subtract *)
| Isqrtf (* floating-point square root *)
| Ibswap of int (* endianness conversion *)
+ | Imove32 (* 32-bit integer move *)
and arith_operation =
Ishiftadd
| Ishiftsub
-let spacetime_node_hole_pointer_is_live_before = function
- | Ifar_alloc _ | Ifar_intop_checkbound _ | Ifar_intop_imm_checkbound _
- | Ishiftarith _ | Ishiftcheckbound _ | Ifar_shiftcheckbound _ -> false
- | Imuladd | Imulsub | Inegmulf | Imuladdf | Inegmuladdf | Imulsubf
- | Inegmulsubf | Isqrtf | Ibswap _ -> false
-
(* Sizes, endianness *)
let big_endian = false
let print_specific_operation printreg op ppf arg =
match op with
- | Ifar_alloc { bytes; label_after_call_gc = _; } ->
+ | Ifar_alloc { bytes; } ->
fprintf ppf "(far) alloc %i" bytes
- | Ifar_intop_checkbound _ ->
+ | Ifar_intop_checkbound ->
fprintf ppf "%a (far) check > %a" printreg arg.(0) printreg arg.(1)
- | Ifar_intop_imm_checkbound { bound; _ } ->
+ | Ifar_intop_imm_checkbound { bound; } ->
fprintf ppf "%a (far) check > %i" printreg arg.(0) bound
| Ishiftarith(op, shift) ->
let op_name = function
else sprintf ">> %i" (-shift) in
fprintf ppf "%a %s %a %s"
printreg arg.(0) (op_name op) printreg arg.(1) shift_mark
- | Ishiftcheckbound { shift; _ } ->
+ | Ishiftcheckbound { shift; } ->
fprintf ppf "check %a >> %i > %a" printreg arg.(0) shift
printreg arg.(1)
- | Ifar_shiftcheckbound { shift; _ } ->
+ | Ifar_shiftcheckbound { shift; } ->
fprintf ppf
"(far) check %a >> %i > %a" printreg arg.(0) shift printreg arg.(1)
| Imuladd ->
| Ibswap n ->
fprintf ppf "bswap%i %a" n
printreg arg.(0)
+ | Imove32 ->
+ fprintf ppf "move32 %a"
+ printreg arg.(0)
let reg_alloc_ptr = phys_reg 24
let reg_alloc_limit = phys_reg 25
let reg_tmp1 = phys_reg 26
-let reg_x15 = phys_reg 15
+let reg_x8 = phys_reg 8
(* Output a label *)
+let label_prefix =
+ if macosx then "L" else ".L"
+
let emit_label lbl =
- emit_string ".L"; emit_int lbl
+ emit_string label_prefix; emit_int lbl
(* Symbols *)
let emit_symbol s =
+ if macosx then emit_string "_";
Emitaux.emit_symbol '$' s
+(* Object types *)
+
+let emit_symbol_type emit_lbl_or_sym lbl_or_sym ty =
+ if not macosx then begin
+ ` .type {emit_lbl_or_sym lbl_or_sym}, %{emit_string ty}\n`
+ end
+
+
+let emit_symbol_size sym =
+ if not macosx then begin
+ ` .size {emit_symbol sym}, .-{emit_symbol sym}\n`
+ end
+
(* Output a pseudo-register *)
let emit_reg = function
let contains_calls = ref false
-let frame_size () =
- let sz =
- !stack_offset +
+let initial_stack_offset () =
8 * num_stack_slots.(0) +
8 * num_stack_slots.(1) +
(if !contains_calls then 8 else 0)
+
+let frame_size () =
+ let sz =
+ !stack_offset +
+ initial_stack_offset ()
in Misc.align sz 16
let slot_offset loc cl =
(* Record live pointers at call points *)
-let record_frame_label ?label live dbg =
- let lbl =
- match label with
- | None -> new_label()
- | Some label -> label
- in
+let record_frame_label live dbg =
+ let lbl = new_label () in
let live_offset = ref [] in
Reg.Set.iter
(function
~live_offset:!live_offset dbg;
lbl
-let record_frame ?label live dbg =
- let lbl = record_frame_label ?label live dbg in `{emit_label lbl}:`
+let record_frame live dbg =
+ let lbl = record_frame_label live dbg in `{emit_label lbl}:`
(* Record calls to the GC -- we've moved them out of the way *)
let bound_error_sites = ref ([] : bound_error_call list)
-let bound_error_label ?label dbg =
+let bound_error_label dbg =
if !Clflags.debug || !bound_error_sites = [] then begin
let lbl_bound_error = new_label() in
- let lbl_frame = record_frame_label ?label Reg.Set.empty (Dbg_other dbg) in
+ let lbl_frame = record_frame_label Reg.Set.empty (Dbg_other dbg) in
bound_error_sites :=
{ bd_lbl = lbl_bound_error;
bd_frame_lbl = lbl_frame } :: !bound_error_sites;
(* reset CFA back because function body may continue *)
if n > 0 then cfi_adjust_cfa_offset n
+(* Output add-immediate / sub-immediate / cmp-immediate instructions *)
+
+let rec emit_addimm rd rs n =
+ if n < 0 then emit_subimm rd rs (-n)
+ else if n <= 0xFFF then
+ ` add {emit_reg rd}, {emit_reg rs}, #{emit_int n}\n`
+ else begin
+ assert (n <= 0xFFF_FFF);
+ let nl = n land 0xFFF and nh = n land 0xFFF_000 in
+ ` add {emit_reg rd}, {emit_reg rs}, #{emit_int nh}\n`;
+ if nl <> 0 then
+ ` add {emit_reg rd}, {emit_reg rd}, #{emit_int nl}\n`
+ end
+
+and emit_subimm rd rs n =
+ if n < 0 then emit_addimm rd rs (-n)
+ else if n <= 0xFFF then
+ ` sub {emit_reg rd}, {emit_reg rs}, #{emit_int n}\n`
+ else begin
+ assert (n <= 0xFFF_FFF);
+ let nl = n land 0xFFF and nh = n land 0xFFF_000 in
+ ` sub {emit_reg rd}, {emit_reg rs}, #{emit_int nh}\n`;
+ if nl <> 0 then
+ ` sub {emit_reg rd}, {emit_reg rd}, #{emit_int nl}\n`
+ end
+
+let emit_cmpimm rs n =
+ if n >= 0
+ then ` cmp {emit_reg rs}, #{emit_int n}\n`
+ else ` cmn {emit_reg rs}, #{emit_int (-n)}\n`
+
(* Name of current function *)
let function_name = ref ""
(* Entry point for tail recursive calls *)
(* Emit all pending literals *)
let emit_literals() =
if !float_literals <> [] then begin
+ if macosx then
+ ` .section __TEXT,__literal8,8byte_literals\n`;
` .align 3\n`;
List.iter
(fun (f, lbl) ->
(* Emit code to load the address of a symbol *)
let emit_load_symbol_addr dst s =
- if not !Clflags.dlcode then begin
+ if macosx then begin
+ ` adrp {emit_reg dst}, {emit_symbol s}@GOTPAGE\n`;
+ ` ldr {emit_reg dst}, [{emit_reg dst}, {emit_symbol s}@GOTPAGEOFF]\n`
+ end else if not !Clflags.dlcode then begin
` adrp {emit_reg dst}, {emit_symbol s}\n`;
` add {emit_reg dst}, {emit_reg dst}, #:lo12:{emit_symbol s}\n`
end else begin
| Lend -> totals
| Lop (Ialloc _) when !fastcode_flag ->
loop instr.next (call_gc + 1, check_bound)
- | Lop (Iintop Icheckbound _)
- | Lop (Iintop_imm (Icheckbound _, _))
+ | Lop (Iintop Icheckbound)
+ | Lop (Iintop_imm (Icheckbound, _))
| Lop (Ispecific (Ishiftcheckbound _)) ->
let check_bound =
(* When not in debug mode, there is at most one check-bound point. *)
(* The following four should never be seen, since this function is run
before branch relaxation. *)
| Lop (Ispecific (Ifar_alloc _))
- | Lop (Ispecific Ifar_intop_checkbound _)
+ | Lop (Ispecific Ifar_intop_checkbound)
| Lop (Ispecific (Ifar_intop_imm_checkbound _))
| Lop (Ispecific (Ifar_shiftcheckbound _)) -> assert false
| _ -> loop instr.next totals
let classify_instr = function
| Lop (Ialloc _)
- | Lop (Iintop Icheckbound _)
- | Lop (Iintop_imm (Icheckbound _, _))
+ | Lop (Iintop Icheckbound)
+ | Lop (Iintop_imm (Icheckbound, _))
| Lop (Ispecific (Ishiftcheckbound _)) -> Some Bcc
(* The various "far" variants in [specific_operation] don't need to
return [Some] here, since their code sequences never contain any
let offset_pc_at_branch = 0
let prologue_size () =
- (if frame_size () > 0 then 2 else 0)
+ (if initial_stack_offset () > 0 then 2 else 0)
+ (if !contains_calls then 1 else 0)
let epilogue_size () =
num_instructions_for_intconst n
| Lop (Iconst_float _) -> 2
| Lop (Iconst_symbol _) -> 2
- | Lop (Icall_ind _) -> 1
+ | Lop (Icall_ind) -> 1
| Lop (Icall_imm _) -> 1
- | Lop (Itailcall_ind _) -> epilogue_size ()
+ | Lop (Itailcall_ind) -> epilogue_size ()
| Lop (Itailcall_imm { func; _ }) ->
if func = !function_name then 1 else epilogue_size ()
| Lop (Iextcall { alloc = false; }) -> 1
end
| Lop (Iintop (Icomp _)) -> 2
| Lop (Iintop_imm (Icomp _, _)) -> 2
- | Lop (Iintop (Icheckbound _)) -> 2
- | Lop (Ispecific (Ifar_intop_checkbound _)) -> 3
- | Lop (Iintop_imm (Icheckbound _, _)) -> 2
+ | Lop (Iintop (Icheckbound)) -> 2
+ | Lop (Ispecific (Ifar_intop_checkbound)) -> 3
+ | Lop (Iintop_imm (Icheckbound, _)) -> 2
| Lop (Ispecific (Ifar_intop_imm_checkbound _)) -> 3
| Lop (Ispecific (Ishiftcheckbound _)) -> 2
| Lop (Ispecific (Ifar_shiftcheckbound _)) -> 3
| Lop (Ispecific (Imuladd | Imulsub)) -> 1
| Lop (Ispecific (Ibswap 16)) -> 2
| Lop (Ispecific (Ibswap _)) -> 1
+ | Lop (Ispecific Imove32) -> 1
| Lop (Iname_for_debugger _) -> 0
| Lreloadretaddr -> 0
| Lreturn -> epilogue_size ()
| Lambda.Raise_notrace -> 4
end
- let relax_allocation ~num_bytes ~label_after_call_gc ~dbginfo =
- Lop (Ispecific (Ifar_alloc { bytes = num_bytes; label_after_call_gc; dbginfo }))
+ let relax_allocation ~num_bytes ~dbginfo =
+ Lop (Ispecific (Ifar_alloc { bytes = num_bytes; dbginfo }))
- let relax_intop_checkbound ~label_after_error =
- Lop (Ispecific (Ifar_intop_checkbound { label_after_error; }))
+ let relax_intop_checkbound () =
+ Lop (Ispecific (Ifar_intop_checkbound))
- let relax_intop_imm_checkbound ~bound ~label_after_error =
- Lop (Ispecific (Ifar_intop_imm_checkbound { bound; label_after_error; }))
+ let relax_intop_imm_checkbound ~bound =
+ Lop (Ispecific (Ifar_intop_imm_checkbound { bound; }))
let relax_specific_op = function
- | Ishiftcheckbound { shift; label_after_error; } ->
- Lop (Ispecific (Ifar_shiftcheckbound { shift; label_after_error; }))
+ | Ishiftcheckbound { shift; } ->
+ Lop (Ispecific (Ifar_shiftcheckbound { shift; }))
| _ -> assert false
end)
(* Output the assembly code for allocation. *)
-let assembly_code_for_allocation ~label_after_call_gc i ~n ~far ~dbginfo =
+let assembly_code_for_allocation i ~n ~far ~dbginfo =
let lbl_frame =
- record_frame_label ?label:label_after_call_gc i.live (Dbg_alloc dbginfo)
+ record_frame_label i.live (Dbg_alloc dbginfo)
in
if !fastcode_flag then begin
let lbl_after_alloc = new_label() in
| 16 -> ` bl {emit_symbol "caml_alloc1"}\n`
| 24 -> ` bl {emit_symbol "caml_alloc2"}\n`
| 32 -> ` bl {emit_symbol "caml_alloc3"}\n`
- | _ -> emit_intconst reg_x15 (Nativeint.of_int n);
+ | _ -> emit_intconst reg_x8 (Nativeint.of_int n);
` bl {emit_symbol "caml_allocN"}\n`
end;
`{emit_label lbl_frame}: add {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, #8\n`
else
` .text\n`
+(* Emit code to load an emitted literal *)
+
+let emit_load_literal dst lbl =
+ if macosx then begin
+ ` adrp {emit_reg reg_tmp1}, {emit_label lbl}@PAGE\n`;
+ ` ldr {emit_reg dst}, [{emit_reg reg_tmp1}, {emit_label lbl}@PAGEOFF]\n`
+ end else begin
+ ` adrp {emit_reg reg_tmp1}, {emit_label lbl}\n`;
+ ` ldr {emit_reg dst}, [{emit_reg reg_tmp1}, #:lo12:{emit_label lbl}]\n`
+ end
+
(* Output the assembly code for an instruction *)
let emit_instr i =
| _ ->
assert false
end
+ | Lop(Ispecific Imove32) ->
+ let src = i.arg.(0) and dst = i.res.(0) in
+ if src.loc <> dst.loc then begin
+ match (src, dst) with
+ | {loc = Reg _}, {loc = Reg _} ->
+ ` mov {emit_wreg dst}, {emit_wreg src}\n`
+ | {loc = Reg _}, {loc = Stack _} ->
+ ` str {emit_wreg src}, {emit_stack dst}\n`
+ | {loc = Stack _}, {loc = Reg _} ->
+ ` ldr {emit_wreg dst}, {emit_stack src}\n`
+ | _ ->
+ assert false
+ end
| Lop(Iconst_int n) ->
emit_intconst i.res.(0) n
| Lop(Iconst_float f) ->
` fmov {emit_reg i.res.(0)}, #{emit_printf "%.7f" (Int64.float_of_bits f)}\n`
else begin
let lbl = float_literal f in
- ` adrp {emit_reg reg_tmp1}, {emit_label lbl}\n`;
- ` ldr {emit_reg i.res.(0)}, [{emit_reg reg_tmp1}, #:lo12:{emit_label lbl}]\n`
+ emit_load_literal i.res.(0) lbl
end
| Lop(Iconst_symbol s) ->
emit_load_symbol_addr i.res.(0) s
- | Lop(Icall_ind { label_after; }) ->
+ | Lop(Icall_ind) ->
` blr {emit_reg i.arg.(0)}\n`;
- `{record_frame i.live (Dbg_other i.dbg) ~label:label_after}\n`
- | Lop(Icall_imm { func; label_after; }) ->
+ `{record_frame i.live (Dbg_other i.dbg)}\n`
+ | Lop(Icall_imm { func; }) ->
` bl {emit_symbol func}\n`;
- `{record_frame i.live (Dbg_other i.dbg) ~label:label_after}\n`
- | Lop(Itailcall_ind { label_after = _; }) ->
+ `{record_frame i.live (Dbg_other i.dbg)}\n`
+ | Lop(Itailcall_ind) ->
output_epilogue (fun () -> ` br {emit_reg i.arg.(0)}\n`)
- | Lop(Itailcall_imm { func; label_after = _; }) ->
+ | Lop(Itailcall_imm { func; }) ->
if func = !function_name then
` b {emit_label !tailrec_entry_point}\n`
else
output_epilogue (fun () -> ` b {emit_symbol func}\n`)
- | Lop(Iextcall { func; alloc = false; label_after = _; }) ->
+ | Lop(Iextcall { func; alloc = false; }) ->
` bl {emit_symbol func}\n`
- | Lop(Iextcall { func; alloc = true; label_after; }) ->
- emit_load_symbol_addr reg_x15 func;
+ | Lop(Iextcall { func; alloc = true; }) ->
+ emit_load_symbol_addr reg_x8 func;
` bl {emit_symbol "caml_c_call"}\n`;
- `{record_frame i.live (Dbg_other i.dbg) ~label:label_after}\n`
+ `{record_frame i.live (Dbg_other i.dbg)}\n`
| Lop(Istackoffset n) ->
assert (n mod 16 = 0);
emit_stack_adjustment (-n);
| Word_int | Word_val | Double | Double_u ->
` str {emit_reg src}, {emit_addressing addr base}\n`
end
- | Lop(Ialloc { bytes = n; label_after_call_gc; dbginfo }) ->
- assembly_code_for_allocation i ~n ~far:false ~label_after_call_gc ~dbginfo
- | Lop(Ispecific (Ifar_alloc { bytes = n; label_after_call_gc; dbginfo })) ->
- assembly_code_for_allocation i ~n ~far:true ~label_after_call_gc ~dbginfo
+ | Lop(Ialloc { bytes = n; dbginfo }) ->
+ assembly_code_for_allocation i ~n ~far:false ~dbginfo
+ | Lop(Ispecific (Ifar_alloc { bytes = n; dbginfo })) ->
+ assembly_code_for_allocation i ~n ~far:true ~dbginfo
+ | Lop(Iintop_imm(Iadd, n)) ->
+ emit_addimm i.res.(0) i.arg.(0) n
+ | Lop(Iintop_imm(Isub, n)) ->
+ emit_subimm i.res.(0) i.arg.(0) n
| Lop(Iintop(Icomp cmp)) ->
` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
` cset {emit_reg i.res.(0)}, {emit_string (name_for_comparison cmp)}\n`
| Lop(Iintop_imm(Icomp cmp, n)) ->
- ` cmp {emit_reg i.arg.(0)}, #{emit_int n}\n`;
+ emit_cmpimm i.arg.(0) n;
` cset {emit_reg i.res.(0)}, {emit_string (name_for_comparison cmp)}\n`
- | Lop(Iintop (Icheckbound { label_after_error; })) ->
- let lbl = bound_error_label i.dbg ?label:label_after_error in
+ | Lop(Iintop (Icheckbound)) ->
+ let lbl = bound_error_label i.dbg in
` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
` b.ls {emit_label lbl}\n`
- | Lop(Ispecific Ifar_intop_checkbound { label_after_error; }) ->
- let lbl = bound_error_label i.dbg ?label:label_after_error in
+ | Lop(Ispecific Ifar_intop_checkbound) ->
+ let lbl = bound_error_label i.dbg in
let lbl2 = new_label () in
` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
` b.hi {emit_label lbl2}\n`;
` b {emit_label lbl}\n`;
`{emit_label lbl2}:\n`;
- | Lop(Iintop_imm(Icheckbound { label_after_error; }, n)) ->
- let lbl = bound_error_label i.dbg ?label:label_after_error in
- ` cmp {emit_reg i.arg.(0)}, #{emit_int n}\n`;
+ | Lop(Iintop_imm(Icheckbound, n)) ->
+ let lbl = bound_error_label i.dbg in
+ emit_cmpimm i.arg.(0) n;
` b.ls {emit_label lbl}\n`
| Lop(Ispecific(
- Ifar_intop_imm_checkbound { bound; label_after_error; })) ->
- let lbl = bound_error_label i.dbg ?label:label_after_error in
+ Ifar_intop_imm_checkbound { bound; })) ->
+ let lbl = bound_error_label i.dbg in
let lbl2 = new_label () in
` cmp {emit_reg i.arg.(0)}, #{emit_int bound}\n`;
` b.hi {emit_label lbl2}\n`;
` b {emit_label lbl}\n`;
`{emit_label lbl2}:\n`;
- | Lop(Ispecific(Ishiftcheckbound { shift; label_after_error; })) ->
- let lbl = bound_error_label i.dbg ?label:label_after_error in
+ | Lop(Ispecific(Ishiftcheckbound { shift; })) ->
+ let lbl = bound_error_label i.dbg in
` cmp {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}, lsr #{emit_int shift}\n`;
` b.cs {emit_label lbl}\n`
- | Lop(Ispecific(Ifar_shiftcheckbound { shift; label_after_error; })) ->
- let lbl = bound_error_label i.dbg ?label:label_after_error in
+ | Lop(Ispecific(Ifar_shiftcheckbound { shift; })) ->
+ let lbl = bound_error_label i.dbg in
let lbl2 = new_label () in
` cmp {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}, lsr #{emit_int shift}\n`;
` b.lo {emit_label lbl2}\n`;
let comp = name_for_comparison cmp in
` b.{emit_string comp} {emit_label lbl}\n`
| Iinttest_imm(cmp, n) ->
- ` cmp {emit_reg i.arg.(0)}, #{emit_int n}\n`;
+ emit_cmpimm i.arg.(0) n;
let comp = name_for_comparison cmp in
` b.{emit_string comp} {emit_label lbl}\n`
| Ifloattest cmp ->
emit_named_text_section !function_name;
` .align 3\n`;
` .globl {emit_symbol fundecl.fun_name}\n`;
- ` .type {emit_symbol fundecl.fun_name}, %function\n`;
+ emit_symbol_type emit_symbol fundecl.fun_name "function";
`{emit_symbol fundecl.fun_name}:\n`;
emit_debug_info fundecl.fun_dbg;
cfi_startproc();
assert (List.length !call_gc_sites = num_call_gc);
assert (List.length !bound_error_sites = num_check_bound);
cfi_endproc();
- ` .type {emit_symbol fundecl.fun_name}, %function\n`;
- ` .size {emit_symbol fundecl.fun_name}, .-{emit_symbol fundecl.fun_name}\n`;
+ emit_symbol_type emit_symbol fundecl.fun_name "function";
+ emit_symbol_size fundecl.fun_name;
emit_literals()
(* Emission of data *)
`{emit_symbol lbl}:\n`;
emit_frames
{ efa_code_label = (fun lbl ->
- ` .type {emit_label lbl}, %function\n`;
+ emit_symbol_type emit_label lbl "function";
` .quad {emit_label lbl}\n`);
efa_data_label = (fun lbl ->
- ` .type {emit_label lbl}, %object\n`;
+ emit_symbol_type emit_label lbl "object";
` .quad {emit_label lbl}\n`);
efa_8 = (fun n -> ` .byte {emit_int n}\n`);
efa_16 = (fun n -> ` .short {emit_int n}\n`);
` .long {emit_label lbl} - . + {emit_int32 ofs}\n`);
efa_def_label = (fun lbl -> `{emit_label lbl}:\n`);
efa_string = (fun s -> emit_string_directive " .asciz " s) };
- ` .type {emit_symbol lbl}, %object\n`;
- ` .size {emit_symbol lbl}, .-{emit_symbol lbl}\n`;
+ emit_symbol_type emit_symbol lbl "object";
+ emit_symbol_size lbl;
begin match Config.system with
| "linux" ->
(* Mark stack as non-executable *)
let phys_reg n =
if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100)
-let reg_x15 = phys_reg 15
+let reg_x8 = phys_reg 8
let reg_d7 = phys_reg 107
let stack_slot slot ty =
Reg.at_location ty (Stack slot)
-let loc_spacetime_node_hole = Reg.dummy (* Spacetime unsupported *)
-
(* Calling conventions *)
+let loc_int last_int make_stack int ofs =
+ if !int <= last_int then begin
+ let l = phys_reg !int in
+ incr int; l
+ end else begin
+ ofs := Misc.align !ofs size_int;
+ let l = stack_slot (make_stack !ofs) Int in
+ ofs := !ofs + size_int; l
+ end
+
+let loc_float last_float make_stack float ofs =
+ if !float <= last_float then begin
+ let l = phys_reg !float in
+ incr float; l
+ end else begin
+ ofs := Misc.align !ofs size_float;
+ let l = stack_slot (make_stack !ofs) Float in
+ ofs := !ofs + size_float; l
+ end
+
+let loc_int32 last_int make_stack int ofs =
+ if !int <= last_int then begin
+ let l = phys_reg !int in
+ incr int; l
+ end else begin
+ let l = stack_slot (make_stack !ofs) Int in
+ ofs := !ofs + (if macosx then 4 else 8);
+ l
+ end
+
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 float = ref first_float in
let ofs = ref 0 in
for i = 0 to Array.length arg - 1 do
- match arg.(i).typ with
- | Val | Int | Addr as ty ->
- if !int <= last_int then begin
- loc.(i) <- phys_reg !int;
- incr int
- end else begin
- loc.(i) <- stack_slot (make_stack !ofs) ty;
- ofs := !ofs + size_int
- end
+ match arg.(i) with
+ | Val | Int | Addr ->
+ loc.(i) <- loc_int last_int make_stack int ofs
| Float ->
- if !float <= last_float then begin
- loc.(i) <- phys_reg !float;
- incr float
- end else begin
- loc.(i) <- stack_slot (make_stack !ofs) Float;
- ofs := !ofs + size_float
- end
+ loc.(i) <- loc_float last_float make_stack float ofs
done;
(loc, Misc.align !ofs 16) (* keep stack 16-aligned *)
Return values in r0...r15 or d0...d15. *)
let max_arguments_for_tailcalls = 16
+let last_int_register = if macosx then 7 else 15
let loc_arguments arg =
- calling_conventions 0 15 100 115 outgoing arg
+ calling_conventions 0 last_int_register 100 115 outgoing arg
let loc_parameters arg =
- let (loc, _) = calling_conventions 0 15 100 115 incoming arg in loc
+ let (loc, _) =
+ calling_conventions 0 last_int_register 100 115 incoming arg
+ in
+ loc
let loc_results res =
- let (loc, _) = calling_conventions 0 15 100 115 not_supported res in loc
+ let (loc, _) =
+ calling_conventions 0 last_int_register 100 115 not_supported res
+ in
+ loc
(* C calling convention:
first integer args in r0...r7
first float args in d0...d7
remaining args on stack.
+ macOS/iOS peculiarity: int32 arguments passed on stack occupy 4 bytes,
+ while the AAPCS64 says 8 bytes.
Return values in r0...r1 or d0. *)
-let loc_external_arguments arg =
- let arg =
- Array.map (fun regs -> assert (Array.length regs = 1); regs.(0)) arg
- in
- let loc, alignment = calling_conventions 0 7 100 107 outgoing arg in
- Array.map (fun reg -> [|reg|]) loc, alignment
+let external_calling_conventions
+ first_int last_int first_float last_float make_stack ty_args =
+ let loc = Array.make (List.length ty_args) [| Reg.dummy |] in
+ let int = ref first_int in
+ let float = ref first_float in
+ let ofs = ref 0 in
+ List.iteri (fun i ty_arg ->
+ begin match ty_arg with
+ | XInt | XInt64 ->
+ loc.(i) <- [| loc_int last_int make_stack int ofs |]
+ | XInt32 ->
+ loc.(i) <- [| loc_int32 last_int make_stack int ofs |]
+ | XFloat ->
+ loc.(i) <- [| loc_float last_float make_stack float ofs |]
+ end)
+ ty_args;
+ (loc, Misc.align !ofs 16) (* keep stack 16-aligned *)
+
+let loc_external_arguments ty_args =
+ 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
124;125;126;127;128;129;130;131])
let destroyed_at_oper = function
- | Iop(Icall_ind _ | Icall_imm _) | Iop(Iextcall { alloc = true; }) ->
+ | Iop(Icall_ind | Icall_imm _) | Iop(Iextcall { alloc = true; }) ->
all_phys_regs
| Iop(Iextcall { alloc = false; }) ->
destroyed_at_c_call
| Iop(Ialloc _) ->
- [| reg_x15 |]
+ [| reg_x8 |]
| Iop(Iintoffloat | Ifloatofint | Iload(Single, _) | Istore(Single, _, _)) ->
[| reg_d7 |] (* d7 / s7 destroyed *)
| _ -> [||]
registers). *)
let op_is_pure = function
- | Icall_ind _ | Icall_imm _ | Itailcall_ind _ | Itailcall_imm _
+ | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
| Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
- | Iintop(Icheckbound _) | Iintop_imm(Icheckbound _, _)
+ | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _)
| Ispecific(Ishiftcheckbound _) -> false
| _ -> true
(* Reloading for the ARM 64 bits *)
+open Reg
+
+class reload = object (self)
+
+inherit Reloadgen.reload_generic as super
+
+method! reload_operation op arg res =
+ match op with
+ | Ispecific Imove32 ->
+ (* Like Imove: argument or result can be on stack but not both *)
+ begin match arg.(0), res.(0) with
+ | {loc = Stack s1}, {loc = Stack s2} when s1 <> s2 ->
+ ([| self#makereg arg.(0) |], res)
+ | _ ->
+ (arg, res)
+ end
+ | _ ->
+ super#reload_operation op arg res
+
+end
+
let fundecl f num_stack_slots =
- (new Reloadgen.reload_generic)#fundecl f num_stack_slots
+ (new reload)#fundecl f num_stack_slots
let is_logical_immediate n =
n <> 0 && n <> -1 && run_automata 64 0 n
+(* Signed immediates are simpler *)
+
+let is_immediate n =
+ let mn = -n in
+ n land 0xFFF = n || n land 0xFFF_000 = n
+ || mn land 0xFFF = mn || mn land 0xFFF_000 = mn
+
(* If you update [inline_ops], you may need to update [is_simple_expr] and/or
[effects_of], below. *)
let inline_ops =
"caml_int64_direct_bswap"; "caml_nativeint_direct_bswap" ]
let use_direct_addressing _symb =
- not !Clflags.dlcode
+ (not !Clflags.dlcode) && (not Arch.macosx)
+
+let is_stack_slot rv =
+ Reg.(match rv with
+ | [| { loc = Stack _ } |] -> true
+ | _ -> false)
(* Instruction selection *)
inherit Selectgen.selector_generic as super
-method is_immediate n =
- let mn = -n in
- n land 0xFFF = n || n land 0xFFF_000 = n
- || mn land 0xFFF = mn || mn land 0xFFF_000 = mn
+method is_immediate_test _cmp n =
+ is_immediate n
+
+method! is_immediate op n =
+ match op with
+ | Iadd | Isub -> n <= 0xFFF_FFF && n >= -0xFFF_FFF
+ | Iand | Ior | Ixor -> is_logical_immediate n
+ | Icomp _ | Icheckbound -> is_immediate n
+ | _ -> super#is_immediate op n
method! is_simple_expr = function
(* inlined floating-point ops are simple if their arguments are *)
(* Integer addition *)
| Caddi | Caddv | Cadda ->
begin match args with
- (* Add immediate *)
- | [arg; Cconst_int (n, _)] when self#is_immediate n ->
- ((if n >= 0 then Iintop_imm(Iadd, n) else Iintop_imm(Isub, -n)),
- [arg])
- | [Cconst_int (n, _); arg] when self#is_immediate n ->
- ((if n >= 0 then Iintop_imm(Iadd, n) else Iintop_imm(Isub, -n)),
- [arg])
(* Shift-add *)
| [arg1; Cop(Clsl, [arg2; Cconst_int (n, _)], _)] when n > 0 && n < 64 ->
(Ispecific(Ishiftarith(Ishiftadd, n)), [arg1; arg2])
(* Integer subtraction *)
| Csubi ->
begin match args with
- (* Sub immediate *)
- | [arg; Cconst_int (n, _)] when self#is_immediate n ->
- ((if n >= 0 then Iintop_imm(Isub, n) else Iintop_imm(Iadd, -n)),
- [arg])
(* Shift-sub *)
| [arg1; Cop(Clsl, [arg2; Cconst_int (n, _)], _)] when n > 0 && n < 64 ->
(Ispecific(Ishiftarith(Ishiftsub, n)), [arg1; arg2])
| Ccheckbound ->
begin match args with
| [Cop(Clsr, [arg1; Cconst_int (n, _)], _); arg2] when n > 0 && n < 64 ->
- (Ispecific(Ishiftcheckbound { shift = n; label_after_error = None; }),
+ (Ispecific(Ishiftcheckbound { shift = n; }),
[arg1; arg2])
| _ ->
super#select_operation op args dbg
end
- (* Integer multiplication *)
- (* ARM does not support immediate operands for multiplication *)
- | Cmuli ->
- (Iintop Imul, args)
- | Cmulhi ->
- (Iintop Imulh, args)
- (* Bitwise logical operations have a different range of immediate
- operands than the other instructions *)
- | Cand -> self#select_logical Iand args
- | Cor -> self#select_logical Ior args
- | Cxor -> self#select_logical Ixor args
(* Recognize floating-point negate and multiply *)
| Cnegf ->
begin match args with
| _ ->
super#select_operation op args dbg
-method select_logical op = function
- | [arg; Cconst_int (n, _)] when is_logical_immediate n ->
- (Iintop_imm(op, n), [arg])
- | [Cconst_int (n, _); arg] when is_logical_immediate n ->
- (Iintop_imm(op, n), [arg])
- | args ->
- (Iintop op, args)
-
+method! insert_move_extcall_arg env ty_arg src dst =
+ if macosx && ty_arg = XInt32 && is_stack_slot dst
+ then self#insert env (Iop (Ispecific Imove32)) src dst
+ else self#insert_moves env src dst
end
let fundecl f = (new selector)#emit_fundecl f
open Misc
open Cmm
-type error = Assembler_error of string
+type error =
+ | Assembler_error of string
+ | Mismatched_for_pack of string option
exception Error of error
if !flag then fprintf ppf "*** %s@.%a@." message Printlinear.fundecl phrase;
phrase
+let start_from_emit = ref true
+
+let should_save_before_emit () =
+ should_save_ir_after Compiler_pass.Scheduling && (not !start_from_emit)
+
+let linear_unit_info =
+ { Linear_format.unit_name = "";
+ items = [];
+ for_pack = None;
+ }
+
+let reset () =
+ start_from_emit := false;
+ if should_save_before_emit () then begin
+ linear_unit_info.unit_name <- Compilenv.current_unit_name ();
+ linear_unit_info.items <- [];
+ linear_unit_info.for_pack <- !Clflags.for_package;
+ end
+
+let save_data dl =
+ if should_save_before_emit () then begin
+ linear_unit_info.items <- Linear_format.(Data dl) :: linear_unit_info.items
+ end;
+ dl
+
+let save_linear f =
+ if should_save_before_emit () then begin
+ linear_unit_info.items <- Linear_format.(Func f) :: linear_unit_info.items
+ end;
+ f
+
+let write_linear prefix =
+ if should_save_before_emit () then begin
+ let filename = Compiler_pass.(to_output_filename Scheduling ~prefix) in
+ linear_unit_info.items <- List.rev linear_unit_info.items;
+ Linear_format.save filename linear_unit_info
+ end
+
let should_emit () =
not (should_stop_after Compiler_pass.Scheduling)
++ pass_dump_linear_if ppf_dump dump_linear "Linearized code"
++ Profile.record ~accumulate:true "scheduling" Scheduling.fundecl
++ pass_dump_linear_if ppf_dump dump_scheduling "After instruction scheduling"
+ ++ save_linear
++ emit_fundecl
+let compile_data dl =
+ dl
+ ++ save_data
+ ++ emit_data
+
let compile_phrase ~ppf_dump p =
if !dump_cmm then fprintf ppf_dump "%a@." Printcmm.phrase p;
match p with
| Cfunction fd -> compile_fundecl ~ppf_dump fd
- | Cdata dl -> emit_data dl
+ | Cdata dl -> compile_data dl
(* For the native toplevel: generates generic functions unless
| _ -> ())
(Cmm_helpers.generic_functions true [Compilenv.current_unit_infos ()])
-let compile_unit asm_filename keep_asm
- obj_filename gen =
+let compile_unit ~output_prefix ~asm_filename ~keep_asm ~obj_filename gen =
+ reset ();
let create_asm = should_emit () &&
(keep_asm || not !Emitaux.binary_backend_available) in
Emitaux.create_asm_file := create_asm;
~exceptionally:(fun () -> remove_file obj_filename)
(fun () ->
if create_asm then Emitaux.output_channel := open_out asm_filename;
- Misc.try_finally gen
+ Misc.try_finally
+ (fun () ->
+ gen ();
+ write_linear output_prefix)
~always:(fun () ->
if create_asm then close_out !Emitaux.output_channel)
~exceptionally:(fun () ->
-> Lambda.program
-> Clambda.with_constants
-let compile_implementation ?toplevel ~backend ~filename ~prefixname ~middle_end
- ~ppf_dump (program : Lambda.program) =
- let asmfile =
+let asm_filename output_prefix =
if !keep_asm_file || !Emitaux.binary_backend_available
- then prefixname ^ ext_asm
+ then output_prefix ^ ext_asm
else Filename.temp_file "camlasm" ext_asm
- in
- compile_unit asmfile !keep_asm_file (prefixname ^ ext_obj)
+
+let compile_implementation ?toplevel ~backend ~filename ~prefixname ~middle_end
+ ~ppf_dump (program : Lambda.program) =
+ compile_unit ~output_prefix:prefixname
+ ~asm_filename:(asm_filename prefixname) ~keep_asm:!keep_asm_file
+ ~obj_filename:(prefixname ^ ext_obj)
(fun () ->
Ident.Set.iter Compilenv.require_global program.required_globals;
let clambda_with_constants =
in
end_gen_implementation ?toplevel ~ppf_dump clambda_with_constants)
+let linear_gen_implementation filename =
+ let open Linear_format in
+ let linear_unit_info, _ = restore filename in
+ (match !Clflags.for_package, linear_unit_info.for_pack with
+ | None, None -> ()
+ | Some expected, Some saved when String.equal expected saved -> ()
+ | _, saved -> raise(Error(Mismatched_for_pack saved)));
+ let emit_item = function
+ | Data dl -> emit_data dl
+ | Func f -> emit_fundecl f
+ in
+ start_from_emit := true;
+ emit_begin_assembly ();
+ Profile.record "Emit" (List.iter emit_item) linear_unit_info.items;
+ emit_end_assembly ()
+
+let compile_implementation_linear output_prefix ~progname =
+ compile_unit ~output_prefix
+ ~asm_filename:(asm_filename output_prefix) ~keep_asm:!keep_asm_file
+ ~obj_filename:(output_prefix ^ ext_obj)
+ (fun () ->
+ linear_gen_implementation progname)
+
(* Error report *)
let report_error ppf = function
| Assembler_error file ->
fprintf ppf "Assembler error, input left in file %a"
Location.print_filename file
+ | Mismatched_for_pack saved ->
+ let msg = function
+ | None -> "without -for-pack"
+ | Some s -> "with -for-pack "^s
+ in
+ fprintf ppf
+ "This input file cannot be compiled %s: it was generated %s."
+ (msg !Clflags.for_package) (msg saved)
let () =
Location.register_error_of_exn
-> Lambda.program
-> unit
+val compile_implementation_linear :
+ string -> progname:string -> unit
+
val compile_phrase :
ppf_dump:Format.formatter -> Cmm.phrase -> unit
-type error = Assembler_error of string
+type error =
+ | Assembler_error of string
+ | Mismatched_for_pack of string option
+
exception Error of error
val report_error: Format.formatter -> error -> unit
-
-val compile_unit:
- string(*asm file*) -> bool(*keep asm*) ->
- string(*obj file*) -> (unit -> unit) -> unit
+val compile_unit
+ : output_prefix:string
+ -> asm_filename:string
+ -> keep_asm:bool
+ -> obj_filename:string
+ -> (unit -> unit)
+ -> unit
reqd)
infos.lib_units tolink
and objfiles =
- if Config.ccomp_type = "msvc"
- && infos.lib_units = []
+ if infos.lib_units = []
&& not (Sys.file_exists (object_file_name obj_name)) then
- (* MSVC doesn't support empty .lib files, so there shouldn't be one
- if the .cmxa contains no units. The file_exists check is added to
- be ultra-defensive for the case where a user has manually added
- things to the .lib file *)
+ (* MSVC doesn't support empty .lib files, and macOS struggles to make
+ them (#6550), so there shouldn't be one if the .cmxa contains no
+ units. The file_exists check is added to be ultra-defensive for the
+ case where a user has manually added things to the .a/.lib file *)
objfiles
else
obj_name :: objfiles
compile_phrase(Cmm_helpers.code_segment_table("_startup" :: name_list));
let all_names = "_startup" :: "_system" :: name_list in
compile_phrase (Cmm_helpers.frame_table all_names);
- if Config.spacetime then begin
- compile_phrase (Cmm_helpers.spacetime_shapes all_names);
- end;
if !Clflags.output_complete_object then
force_linking_of_startup ~ppf_dump;
Emit.end_assembly ()
then output_name ^ ".startup" ^ ext_asm
else Filename.temp_file "camlstartup" ext_asm in
let startup_obj = output_name ^ ".startup" ^ ext_obj in
- Asmgen.compile_unit
- startup !Clflags.keep_startup_file startup_obj
+ Asmgen.compile_unit ~output_prefix:output_name
+ ~asm_filename:startup ~keep_asm:!Clflags.keep_startup_file
+ ~obj_filename:startup_obj
(fun () ->
make_shared_startup_file ~ppf_dump
(List.map (fun (ui,_,crc) -> (ui,crc)) units_tolink)
and main_obj_runtime = !Clflags.output_complete_object
in
let files = startup_file :: (List.rev file_list) in
- let libunwind =
- if not Config.spacetime then []
- else if not Config.libunwind_available then []
- else String.split_on_char ' ' Config.libunwind_link_flags
- in
let files, c_lib =
if (not !Clflags.output_c_object) || main_dll || main_obj_runtime then
- files @ (List.rev !Clflags.ccobjs) @ runtime_lib () @ libunwind,
+ files @ (List.rev !Clflags.ccobjs) @ runtime_lib (),
(if !Clflags.nopervasives || (main_obj_runtime && not main_dll)
then "" else Config.native_c_libraries)
else
then output_name ^ ".startup" ^ ext_asm
else Filename.temp_file "camlstartup" ext_asm in
let startup_obj = Filename.temp_file "camlstartup" ext_obj in
- Asmgen.compile_unit
- startup !Clflags.keep_startup_file startup_obj
+ Asmgen.compile_unit ~output_prefix:output_name
+ ~asm_filename:startup ~keep_asm:!Clflags.keep_startup_file
+ ~obj_filename:startup_obj
(fun () -> make_startup_file ~ppf_dump units_tolink ~crc_interfaces);
Misc.try_finally
(fun () ->
in
match instr.desc with
| Lop (Ialloc _)
- | Lop (Iintop (Icheckbound _))
- | Lop (Iintop_imm (Icheckbound _, _))
+ | Lop (Iintop (Icheckbound))
+ | Lop (Iintop_imm (Icheckbound, _))
| Lop (Ispecific _) ->
(* We assume that any branches eligible for relaxation generated
by these instructions only branch forward. We further assume
fixup did_fix (pc + T.instr_size instr.desc) instr.next
else
match instr.desc with
- | Lop (Ialloc { bytes = num_bytes; label_after_call_gc; dbginfo }) ->
- instr.desc <- T.relax_allocation ~num_bytes
- ~dbginfo ~label_after_call_gc;
+ | Lop (Ialloc { bytes = num_bytes; dbginfo }) ->
+ instr.desc <- T.relax_allocation ~num_bytes ~dbginfo;
fixup true (pc + T.instr_size instr.desc) instr.next
- | Lop (Iintop (Icheckbound { label_after_error; })) ->
- instr.desc <- T.relax_intop_checkbound ~label_after_error;
+ | Lop (Iintop (Icheckbound)) ->
+ instr.desc <- T.relax_intop_checkbound ();
fixup true (pc + T.instr_size instr.desc) instr.next
- | Lop (Iintop_imm (Icheckbound { label_after_error; }, bound)) ->
+ | Lop (Iintop_imm (Icheckbound, bound)) ->
instr.desc
- <- T.relax_intop_imm_checkbound ~bound ~label_after_error;
+ <- T.relax_intop_imm_checkbound ~bound;
fixup true (pc + T.instr_size instr.desc) instr.next
| Lop (Ispecific specific) ->
instr.desc <- T.relax_specific_op specific;
the size of out-of-line code (cf. branch_relaxation.mli). *)
val relax_allocation
: num_bytes:int
- -> label_after_call_gc:Cmm.label option
-> dbginfo:Debuginfo.alloc_dbginfo
-> Linear.instruction_desc
val relax_intop_checkbound
- : label_after_error:Cmm.label option
+ : unit
-> Linear.instruction_desc
val relax_intop_imm_checkbound
: bound:int
- -> label_after_error:Cmm.label option
-> Linear.instruction_desc
val relax_specific_op : Arch.specific_operation -> Linear.instruction_desc
end
| Float, (Int | Addr | Val) ->
assert false
+type exttype =
+ | XInt
+ | XInt32
+ | XInt64
+ | XFloat
+
+let machtype_of_exttype = function
+ | XInt -> typ_int
+ | XInt32 -> typ_int
+ | XInt64 -> if Arch.size_int = 4 then [|Int;Int|] else typ_int
+ | XFloat -> typ_float
+
+let machtype_of_exttype_list xtl =
+ Array.concat (List.map machtype_of_exttype xtl)
+
type integer_comparison = Lambda.integer_comparison =
| Ceq | Cne | Clt | Cgt | Cle | Cge
let swap_float_comparison = Lambda.swap_float_comparison
type label = int
-let label_counter = ref 99
+let init_label = 99
+
+let label_counter = ref init_label
+
+let set_label l =
+ if (l < !label_counter) then begin
+ Misc.fatal_errorf "Cannot set label counter to %d, it must be >= %d"
+ l !label_counter ()
+ end;
+ label_counter := l
+
+let cur_label () = !label_counter
let new_label() = incr label_counter; !label_counter
and operation =
Capply of machtype
- | Cextcall of string * machtype * bool * label option
- (** If specified, the given label will be placed immediately after the
- call (at the same place as any frame descriptor would reference). *)
+ | Cextcall of string * machtype * exttype list * bool
| Cload of memory_chunk * Asttypes.mutable_flag
| Calloc
| Cstore of memory_chunk * Lambda.initialization_or_assignment
| Cconst_natint of nativeint * Debuginfo.t
| Cconst_float of float * Debuginfo.t
| Cconst_symbol of string * Debuginfo.t
- | Cconst_pointer of int * Debuginfo.t
- | Cconst_natpointer of nativeint * Debuginfo.t
- | Cblockheader of nativeint * Debuginfo.t
| Cvar of Backend_var.t
| Clet of Backend_var.With_provenance.t * expression * expression
| Clet_mut of Backend_var.With_provenance.t * machtype
Ccatch(Nonrecursive, [i, ids, e2, dbg], e1)
let reset () =
- label_counter := 99
+ label_counter := init_label
let iter_shallow_tail f = function
| Clet(_, _, body) | Cphantom_let (_, _, body) | Clet_mut(_, _, _, body) ->
| Cconst_natint _
| Cconst_float _
| Cconst_symbol _
- | Cconst_pointer _
- | Cconst_natpointer _
- | Cblockheader _
| Cvar _
| Cassign _
| Ctuple _
| Cconst_natint _
| Cconst_float _
| Cconst_symbol _
- | Cconst_pointer _
- | Cconst_natpointer _
- | Cblockheader _
| Cvar _
| Cassign _
| Ctuple _
| Cconst_natint _
| Cconst_float _
| Cconst_symbol _
- | Cconst_pointer _
- | Cconst_natpointer _
- | Cblockheader _
| Cvar _
as c ->
c
-> machtype_component
-> bool
+type exttype =
+ | XInt (**r OCaml value, word-sized integer *)
+ | XInt32 (**r 32-bit integer *)
+ | XInt64 (**r 64-bit integer *)
+ | XFloat (**r double-precision FP number *)
+(** A variant of [machtype] used to describe arguments
+ to external C functions *)
+
+val machtype_of_exttype: exttype -> machtype
+val machtype_of_exttype_list: exttype list -> machtype
+
type integer_comparison = Lambda.integer_comparison =
| Ceq | Cne | Clt | Cgt | Cle | Cge
type label = int
val new_label: unit -> label
+val set_label: label -> unit
+val cur_label: unit -> label
type rec_flag = Nonrecursive | Recursive
and operation =
Capply of machtype
- | Cextcall of string * machtype * bool * label option
+ | Cextcall of string * machtype * exttype list * bool
+ (** The [machtype] is the machine type of the result.
+ The [exttype list] describes the unboxing types of the arguments.
+ An empty list means "all arguments are machine words [XInt]". *)
| Cload of memory_chunk * Asttypes.mutable_flag
| Calloc
| Cstore of memory_chunk * Lambda.initialization_or_assignment
| Cconst_natint of nativeint * Debuginfo.t
| Cconst_float of float * Debuginfo.t
| Cconst_symbol of string * Debuginfo.t
- | Cconst_pointer of int * Debuginfo.t
- | Cconst_natpointer of nativeint * Debuginfo.t
- | Cblockheader of nativeint * Debuginfo.t
| Cvar of Backend_var.t
| Clet of Backend_var.With_provenance.t * expression * expression
| Clet_mut of Backend_var.With_provenance.t * machtype
let bind name arg fn =
match arg with
- Cvar _ | Cconst_int _ | Cconst_natint _ | Cconst_symbol _
- | Cconst_pointer _ | Cconst_natpointer _
- | Cblockheader _ -> fn arg
+ Cvar _ | Cconst_int _ | Cconst_natint _ | Cconst_symbol _ -> fn arg
| _ -> let id = V.create_local name in Clet(VP.create id, arg, fn (Cvar id))
let bind_load name arg fn =
let bind_nonvar name arg fn =
match arg with
- Cconst_int _ | Cconst_natint _ | Cconst_symbol _
- | Cconst_pointer _ | Cconst_natpointer _
- | Cblockheader _ -> fn arg
+ Cconst_int _ | Cconst_natint _ | Cconst_symbol _ -> fn arg
| _ -> let id = V.create_local name in Clet(VP.create id, arg, fn (Cvar id))
let caml_black = Nativeint.shift_left (Nativeint.of_int 3) 8
let caml_int32_ops = "caml_int32_ops"
let caml_int64_ops = "caml_int64_ops"
-
-let alloc_float_header dbg = Cblockheader (float_header, dbg)
-let alloc_floatarray_header len dbg = Cblockheader (floatarray_header len, dbg)
-let alloc_closure_header sz dbg = Cblockheader (white_closure_header sz, dbg)
-let alloc_infix_header ofs dbg = Cblockheader (infix_header ofs, dbg)
-let alloc_boxedint32_header dbg = Cblockheader (boxedint32_header, dbg)
-let alloc_boxedint64_header dbg = Cblockheader (boxedint64_header, dbg)
-let alloc_boxedintnat_header dbg = Cblockheader (boxedintnat_header, dbg)
+let pos_arity_in_closinfo = 8 * size_addr - 8
+ (* arity = the top 8 bits of the closinfo word *)
+
+let closure_info ~arity ~startenv =
+ assert (-128 <= arity && arity <= 127);
+ assert (0 <= startenv && startenv < 1 lsl (pos_arity_in_closinfo - 1));
+ Nativeint.(add (shift_left (of_int arity) pos_arity_in_closinfo)
+ (add (shift_left (of_int startenv) 1)
+ 1n))
+
+let alloc_float_header dbg = Cconst_natint (float_header, dbg)
+let alloc_floatarray_header len dbg = Cconst_natint (floatarray_header len, dbg)
+let alloc_closure_header sz dbg = Cconst_natint (white_closure_header sz, dbg)
+let alloc_infix_header ofs dbg = Cconst_natint (infix_header ofs, dbg)
+let alloc_closure_info ~arity ~startenv dbg =
+ Cconst_natint (closure_info ~arity ~startenv, dbg)
+let alloc_boxedint32_header dbg = Cconst_natint (boxedint32_header, dbg)
+let alloc_boxedint64_header dbg = Cconst_natint (boxedint64_header, dbg)
+let alloc_boxedintnat_header dbg = Cconst_natint (boxedintnat_header, dbg)
(* Integers *)
res = t + sign-bit(c1)
*)
bind "dividend" c1 (fun c1 ->
- let t = Cop(Cmulhi, [c1; Cconst_natint (m, dbg)], dbg) in
+ let t = Cop(Cmulhi, [c1; natint_const_untagged dbg m], dbg) in
let t = if m < 0n then Cop(Caddi, [t; c1], dbg) else t in
let t =
if p > 0 then Cop(Casr, [t; Cconst_int (p, dbg)], dbg) else t
let unbox_float dbg =
map_tail
(function
- | Cop(Calloc, [Cblockheader (hdr, _); c], _)
+ | Cop(Calloc, [Cconst_natint (hdr, _); c], _)
when Nativeint.equal hdr float_header ->
c
| Cconst_symbol (s, _dbg) as cmm ->
(* Unit *)
-let return_unit dbg c = Csequence(c, Cconst_pointer (1, dbg))
+let return_unit dbg c = Csequence(c, Cconst_int (1, dbg))
let rec remove_unit = function
- Cconst_pointer (1, _) -> Ctuple []
- | Csequence(c, Cconst_pointer (1, _)) -> c
+ Cconst_int (1, _) -> Ctuple []
+ | Csequence(c, Cconst_int (1, _)) -> c
| Csequence(c1, c2) ->
Csequence(c1, remove_unit c2)
| Cifthenelse(cond, ifso_dbg, ifso, ifnot_dbg, ifnot, dbg) ->
Clet(id, c1, remove_unit c2)
| Cop(Capply _mty, args, dbg) ->
Cop(Capply typ_void, args, dbg)
- | Cop(Cextcall(proc, _mty, alloc, label_after), args, dbg) ->
- Cop(Cextcall(proc, typ_void, alloc, label_after), args, dbg)
+ | Cop(Cextcall(proc, _ty_res, ty_args, alloc), args, dbg) ->
+ Cop(Cextcall(proc, typ_void, ty_args, alloc), args, dbg)
| Cexit (_,_) as c -> c
| Ctuple [] as c -> c
| c -> Csequence(c, Ctuple [])
box_float dbg (unboxed_float_array_ref arr ofs dbg)
let addr_array_set arr ofs newval dbg =
- Cop(Cextcall("caml_modify", typ_void, false, None),
+ Cop(Cextcall("caml_modify", typ_void, [], false),
[array_indexing log2_size_addr arr ofs dbg; newval], dbg)
let addr_array_initialize arr ofs newval dbg =
- Cop(Cextcall("caml_initialize", typ_void, false, None),
+ Cop(Cextcall("caml_initialize", typ_void, [], false),
[array_indexing log2_size_addr arr ofs dbg; newval], dbg)
let int_array_set arr ofs newval dbg =
Cop(Cstore (Word_int, Lambda.Assignment),
let lookup_tag obj tag dbg =
bind "tag" tag (fun tag ->
- Cop(Cextcall("caml_get_public_method", typ_val, false, None),
+ Cop(Cextcall("caml_get_public_method", typ_val, [], false),
[obj; tag],
dbg))
let make_alloc_generic set_fn dbg tag wordsize args =
if wordsize <= Config.max_young_wosize then
- Cop(Calloc, Cblockheader(block_header tag wordsize, dbg) :: args, dbg)
+ Cop(Calloc, Cconst_natint(block_header tag wordsize, dbg) :: args, dbg)
else begin
let id = V.create_local "*alloc*" in
let rec fill_fields idx = function
| e1::el -> Csequence(set_fn (Cvar id) (Cconst_int (idx, dbg)) e1 dbg,
fill_fields (idx + 2) el) in
Clet(VP.create id,
- Cop(Cextcall("caml_alloc", typ_val, true, None),
+ Cop(Cextcall("caml_alloc", typ_val, [], true),
[Cconst_int (wordsize, dbg); Cconst_int (tag, dbg)], dbg),
fill_fields 1 args)
end
let make_alloc dbg tag args =
let addr_array_init arr ofs newval dbg =
- Cop(Cextcall("caml_initialize", typ_void, false, None),
+ Cop(Cextcall("caml_initialize", typ_void, [], false),
[array_indexing log2_size_addr arr ofs dbg; newval], dbg)
in
make_alloc_generic addr_array_init dbg tag (List.length args) args
(if the word size is 32, this is a no-op) *)
let zero_extend_32 dbg e =
if size_int = 4 then e else
- Cop(Cand, [low_32 dbg e; Cconst_natint(0xFFFFFFFFn, dbg)], dbg)
+ Cop(Cand, [low_32 dbg e; natint_const_untagged dbg 0xFFFFFFFFn], dbg)
(* Boxed integers *)
let alloc_matches_boxed_int bi ~hdr ~ops =
match (bi : Primitive.boxed_integer), hdr, ops with
- | Pnativeint, Cblockheader (hdr, _dbg), Cconst_symbol (sym, _) ->
+ | Pnativeint, Cconst_natint (hdr, _dbg), Cconst_symbol (sym, _) ->
Nativeint.equal hdr boxedintnat_header
&& String.equal sym caml_nativeint_ops
- | Pint32, Cblockheader (hdr, _dbg), Cconst_symbol (sym, _) ->
+ | Pint32, Cconst_natint (hdr, _dbg), Cconst_symbol (sym, _) ->
Nativeint.equal hdr boxedint32_header
&& String.equal sym caml_int32_ops
- | Pint64, Cblockheader (hdr, _dbg), Cconst_symbol (sym, _) ->
+ | Pint64, Cconst_natint (hdr, _dbg), Cconst_symbol (sym, _) ->
Nativeint.equal hdr boxedint64_header
&& String.equal sym caml_int64_ops
| (Pnativeint | Pint32 | Pint64), _, _ -> false
| Cconst_symbol (s, _dbg) as cmm ->
begin match Cmmgen_state.structured_constant_of_sym s, bi with
| Some (Uconst_nativeint n), Primitive.Pnativeint ->
- Cconst_natint (n, dbg)
+ natint_const_untagged dbg n
| Some (Uconst_int32 n), Primitive.Pint32 ->
- Cconst_natint (Nativeint.of_int32 n, dbg)
+ natint_const_untagged dbg (Nativeint.of_int32 n)
| Some (Uconst_int64 n), Primitive.Pint64 ->
if size_int = 8 then
- Cconst_natint (Int64.to_nativeint n, dbg)
+ natint_const_untagged dbg (Int64.to_nativeint n)
else
let low = Int64.to_nativeint n in
let high =
Int64.to_nativeint (Int64.shift_right_logical n 32)
in
if big_endian then
- Ctuple [Cconst_natint (high, dbg); Cconst_natint (low, dbg)]
+ Ctuple [natint_const_untagged dbg high;
+ natint_const_untagged dbg low]
else
- Ctuple [Cconst_natint (low, dbg); Cconst_natint (high, dbg)]
+ Ctuple [natint_const_untagged dbg low;
+ natint_const_untagged dbg high]
| _ ->
default cmm
end
function
(* Constant integers loaded from a table should end in 1,
so that Cload never produces untagged integers *)
- | Cconst_int (n, _), _dbg
- | Cconst_pointer (n, _), _dbg when (n land 1) = 1 ->
+ | Cconst_int (n, _), _dbg when (n land 1) = 1 ->
Some (Cint (Nativeint.of_int n))
| Cconst_natint (n, _), _dbg
- | Cconst_natpointer (n, _), _dbg
when Nativeint.(to_int (logand n one) = 1) ->
Some (Cint n)
| Cconst_symbol (s,_), _dbg ->
(args, clos,
if arity = 1 then app_fun clos 0 else
Cifthenelse(
- Cop(Ccmpi Ceq, [get_field_gen Asttypes.Mutable (Cvar clos) 1 (dbg ());
- int_const (dbg ()) arity], dbg ()),
+ Cop(Ccmpi Ceq, [Cop(Casr,
+ [get_field_gen Asttypes.Mutable (Cvar clos) 1 (dbg());
+ Cconst_int(pos_arity_in_closinfo, dbg())], dbg());
+ Cconst_int(arity, dbg())], dbg()),
dbg (),
Cop(Capply typ_val,
get_field_gen Asttypes.Mutable (Cvar clos) 2 (dbg ())
Cop(Calloc,
[alloc_closure_header 5 (dbg ());
Cconst_symbol(name1 ^ "_" ^ Int.to_string (num+1), dbg ());
- int_const (dbg ()) (arity - num - 1);
+ alloc_closure_info ~arity:(arity - num - 1)
+ ~startenv:3 (dbg ());
Cconst_symbol(name1 ^ "_" ^ Int.to_string (num+1) ^ "_app",
dbg ());
Cvar arg; Cvar clos],
Cop(Calloc,
[alloc_closure_header 4 (dbg ());
Cconst_symbol(name1 ^ "_" ^ Int.to_string (num+1), dbg ());
- int_const (dbg ()) 1; Cvar arg; Cvar clos],
+ alloc_closure_info ~arity:1 ~startenv:2 (dbg ());
+ Cvar arg; Cvar clos],
dbg ());
fun_codegen_options = [];
fun_dbg;
Cop(Cor, [float_array_length_shifted hdr dbg; Cconst_int (1, dbg)], dbg)
let bbswap bi arg dbg =
- let prim = match (bi : Primitive.boxed_integer) with
- | Pnativeint -> "nativeint"
- | Pint32 -> "int32"
- | Pint64 -> "int64"
+ let prim, tyarg = match (bi : Primitive.boxed_integer) with
+ | Pnativeint -> "nativeint", XInt
+ | Pint32 -> "int32", XInt32
+ | Pint64 -> "int64", XInt64
in
Cop(Cextcall(Printf.sprintf "caml_%s_direct_bswap" prim,
- typ_int, false, None),
+ typ_int, [tyarg], false),
[arg],
dbg)
let bswap16 arg dbg =
- (Cop(Cextcall("caml_bswap16_direct", typ_int, false, None),
+ (Cop(Cextcall("caml_bswap16_direct", typ_int, [], false),
[arg],
dbg))
let setfield n ptr init arg1 arg2 dbg =
match assignment_kind ptr init with
| Caml_modify ->
- return_unit dbg (Cop(Cextcall("caml_modify", typ_void, false, None),
- [field_address arg1 n dbg;
- arg2],
- dbg))
+ return_unit dbg
+ (Cop(Cextcall("caml_modify", typ_void, [], false),
+ [field_address arg1 n dbg; arg2],
+ dbg))
| Caml_initialize ->
- return_unit dbg (Cop(Cextcall("caml_initialize", typ_void, false, None),
- [field_address arg1 n dbg;
- arg2],
- dbg))
+ return_unit dbg
+ (Cop(Cextcall("caml_initialize", typ_void, [], false),
+ [field_address arg1 n dbg; arg2],
+ dbg))
| Simple ->
return_unit dbg (set_field arg1 n arg2 init dbg)
List.map mksym namelist
@ [cint_zero])
-(* Generate the master table of Spacetime shapes *)
-
-let spacetime_shapes namelist =
- let mksym name =
- Csymbol_address (
- Compilenv.make_symbol ~unitname:name (Some "spacetime_shapes"))
- in
- Cdata(Cglobal_symbol "caml_spacetime_shapes" ::
- Cdefine_symbol "caml_spacetime_shapes" ::
- List.map mksym namelist
- @ [cint_zero])
-
(* Generate the table of module data and code segments *)
let segment_table namelist symbol begname endname =
assert (clos_vars = []);
cdefine_symbol symb @ clos_vars @ cont
| f1 :: remainder ->
+ let startenv = fundecls_size fundecls in
let rec emit_others pos = function
[] -> clos_vars @ cont
| (f2 : Clambda.ufunction) :: rem ->
Cint(infix_header pos) ::
(closure_symbol f2) @
Csymbol_address f2.label ::
- cint_const f2.arity ::
+ Cint(closure_info ~arity:f2.arity ~startenv:(startenv - pos)) ::
emit_others (pos + 3) rem
else
Cint(infix_header pos) ::
(closure_symbol f2) @
Csymbol_address(curry_function_sym f2.arity) ::
- cint_const f2.arity ::
+ Cint(closure_info ~arity:f2.arity ~startenv:(startenv - pos)) ::
Csymbol_address f2.label ::
emit_others (pos + 4) rem in
Cint(black_closure_header (fundecls_size fundecls
(closure_symbol f1) @
if f1.arity = 1 || f1.arity = 0 then
Csymbol_address f1.label ::
- cint_const f1.arity ::
+ Cint(closure_info ~arity:f1.arity ~startenv) ::
emit_others 3 remainder
else
Csymbol_address(curry_function_sym f1.arity) ::
- cint_const f1.arity ::
+ Cint(closure_info ~arity:f1.arity ~startenv) ::
Csymbol_address f1.label ::
emit_others 4 remainder
val boxedint64_header : nativeint
val boxedintnat_header : nativeint
+(** Closure info for a closure of given arity and distance to environment *)
+val closure_info : arity:int -> startenv:int -> nativeint
+
(** Wrappers *)
val alloc_float_header : Debuginfo.t -> expression
val alloc_floatarray_header : int -> Debuginfo.t -> expression
val alloc_closure_header : int -> Debuginfo.t -> expression
val alloc_infix_header : int -> Debuginfo.t -> expression
+val alloc_closure_info :
+ arity:int -> startenv:int -> Debuginfo.t -> expression
val alloc_boxedint32_header : Debuginfo.t -> expression
val alloc_boxedint64_header : Debuginfo.t -> expression
val alloc_boxedintnat_header : Debuginfo.t -> expression
from the given compilation units *)
val frame_table: string list -> phrase
-(** Generate the caml_spacetime_shapes table, referencing the spacetime shapes
- from the given compilation units *)
-val spacetime_shapes: string list -> phrase
-
(** Generate the tables for data and code positions respectively of the given
compilation units *)
val data_segment_table: string list -> phrase
let transl_constant dbg = function
| Uconst_int n ->
int_const dbg n
- | Uconst_ptr n ->
- if n <= max_repr_int && n >= min_repr_int
- then Cconst_pointer((n lsl 1) + 1, dbg)
- else Cconst_natpointer
- (Nativeint.add (Nativeint.shift_left (Nativeint.of_int n) 1) 1n,
- dbg)
- | Uconst_ref (label, _) ->
+ | Uconst_ref (label, def_opt) ->
+ Option.iter
+ (fun def -> Cmmgen_state.add_structured_constant label def)
+ def_opt;
Cconst_symbol (label, dbg)
let emit_constant cst cont =
match cst with
- | Uconst_int n | Uconst_ptr n ->
+ | Uconst_int n ->
cint_const n
:: cont
| Uconst_ref (sym, _) ->
r := join_unboxed_number_kind ~strict !r k
in
let rec aux = function
- | Cop(Calloc, [Cblockheader (hdr, _); _], dbg)
+ | Cop(Calloc, [Cconst_natint (hdr, _); _], dbg)
when Nativeint.equal hdr float_header ->
notify (Boxed (Boxed_float dbg, false))
- | Cop(Calloc, [Cblockheader (hdr, _); Cconst_symbol (ops, _); _], dbg) ->
+ | Cop(Calloc, [Cconst_natint (hdr, _); Cconst_symbol (ops, _); _], dbg) ->
if Nativeint.equal hdr boxedintnat_header
&& String.equal ops caml_nativeint_ops
then
in
Cconst_symbol (sym, dbg)
| Uclosure(fundecls, clos_vars) ->
+ let startenv = fundecls_size fundecls in
let rec transl_fundecls pos = function
[] ->
List.map (transl env) clos_vars
let without_header =
if f.arity = 1 || f.arity = 0 then
Cconst_symbol (f.label, dbg) ::
- int_const dbg f.arity ::
+ alloc_closure_info ~arity:f.arity
+ ~startenv:(startenv - pos) dbg ::
transl_fundecls (pos + 3) rem
else
Cconst_symbol (curry_function_sym f.arity, dbg) ::
- int_const dbg f.arity ::
+ alloc_closure_info ~arity:f.arity
+ ~startenv:(startenv - pos) dbg ::
Cconst_symbol (f.label, dbg) ::
transl_fundecls (pos + 4) rem
in
- if pos = 0 then without_header
- else (alloc_infix_header pos f.dbg) :: without_header
+ if pos = 0
+ then without_header
+ else alloc_infix_header pos f.dbg :: without_header
in
let dbg =
match fundecls with
Cphantom_const_symbol sym
| Uphantom_read_symbol_field { sym; field; } ->
Cphantom_read_symbol_field { sym; field; }
- | Uphantom_const (Uconst_int i) | Uphantom_const (Uconst_ptr i) ->
+ | Uphantom_const (Uconst_int i) ->
Cphantom_const_int (targetint_const i)
| Uphantom_var var -> Cphantom_var var
| Uphantom_read_field { var; field; } ->
and transl_make_array dbg env kind args =
match kind with
| Pgenarray ->
- Cop(Cextcall("caml_make_array", typ_val, true, None),
+ Cop(Cextcall("caml_make_array", typ_val, [], true),
[make_alloc dbg 0 (List.map (transl env) args)], dbg)
| Paddrarray | Pintarray ->
make_alloc dbg 0 (List.map (transl env) args)
and transl_ccall env prim args dbg =
let transl_arg native_repr arg =
match native_repr with
- | Same_as_ocaml_repr -> transl env arg
- | Unboxed_float -> transl_unbox_float dbg env arg
- | Unboxed_integer bi -> transl_unbox_int dbg env bi arg
- | Untagged_int -> untag_int (transl env arg) dbg
+ | Same_as_ocaml_repr ->
+ (XInt, transl env arg)
+ | Unboxed_float ->
+ (XFloat, transl_unbox_float dbg env arg)
+ | Unboxed_integer bi ->
+ let xty =
+ match bi with
+ | Pnativeint -> XInt
+ | Pint32 -> XInt32
+ | Pint64 -> XInt64 in
+ (xty, transl_unbox_int dbg env bi arg)
+ | Untagged_int ->
+ (XInt, untag_int (transl env arg) dbg)
in
let rec transl_args native_repr_args args =
match native_repr_args, args with
| [], args ->
(* We don't require the two lists to be of the same length as
[default_prim] always sets the arity to [0]. *)
- List.map (transl env) args
- | _, [] -> assert false
+ (List.map (fun _ -> XInt) args, List.map (transl env) args)
+ | _, [] ->
+ assert false
| native_repr :: native_repr_args, arg :: args ->
- transl_arg native_repr arg :: transl_args native_repr_args args
+ let (ty1, arg') = transl_arg native_repr arg in
+ let (tys, args') = transl_args native_repr_args args in
+ (ty1 :: tys, arg' :: args')
in
let typ_res, wrap_result =
match prim.prim_native_repr_res with
| Unboxed_integer bi -> (typ_int, box_int dbg bi)
| Untagged_int -> (typ_int, (fun i -> tag_int i dbg))
in
- let args = transl_args prim.prim_native_repr_args args in
+ let typ_args, args = transl_args prim.prim_native_repr_args args in
wrap_result
(Cop(Cextcall(Primitive.native_name prim,
- typ_res, prim.prim_alloc, None), args, dbg))
+ typ_res, typ_args, prim.prim_alloc), args, dbg))
and transl_prim_1 env p arg dbg =
match p with
| Pnot ->
transl_if env Then_false_else_true
dbg arg
- dbg (Cconst_pointer (1, dbg))
- dbg (Cconst_pointer (3, dbg))
+ dbg (Cconst_int (1, dbg))
+ dbg (Cconst_int (3, dbg))
(* Test integer/block *)
| Pisint ->
tag_int(Cop(Cand, [transl env arg; Cconst_int (1, dbg)], dbg)) dbg
transl_sequand env Then_true_else_false
dbg arg1
dbg' arg2
- dbg (Cconst_pointer (3, dbg))
- dbg' (Cconst_pointer (1, dbg))
+ dbg (Cconst_int (3, dbg))
+ dbg' (Cconst_int (1, dbg))
(* let id = V.create_local "res1" in
Clet(id, transl env arg1,
Cifthenelse(test_bool dbg (Cvar id), transl env arg2, Cvar id)) *)
transl_sequor env Then_true_else_false
dbg arg1
dbg' arg2
- dbg (Cconst_pointer (3, dbg))
- dbg' (Cconst_pointer (1, dbg))
+ dbg (Cconst_int (3, dbg))
+ dbg' (Cconst_int (1, dbg))
(* Integer operations *)
| Paddint ->
add_int_caml (transl env arg1) (transl env arg2) dbg
(* Boxed integers *)
| Paddbint bi ->
- box_int dbg bi (Cop(Caddi,
- [transl_unbox_int_low dbg env bi arg1;
- transl_unbox_int_low dbg env bi arg2], dbg))
+ box_int dbg bi (add_int
+ (transl_unbox_int_low dbg env bi arg1)
+ (transl_unbox_int_low dbg env bi arg2) dbg)
| Psubbint bi ->
- box_int dbg bi (Cop(Csubi,
- [transl_unbox_int_low dbg env bi arg1;
- transl_unbox_int_low dbg env bi arg2], dbg))
+ box_int dbg bi (sub_int
+ (transl_unbox_int_low dbg env bi arg1)
+ (transl_unbox_int_low dbg env bi arg2) dbg)
| Pmulbint bi ->
- box_int dbg bi (Cop(Cmuli,
- [transl_unbox_int_low dbg env bi arg1;
- transl_unbox_int_low dbg env bi arg2], dbg))
+ box_int dbg bi (mul_int
+ (transl_unbox_int_low dbg env bi arg1)
+ (transl_unbox_int_low dbg env bi arg2) dbg)
| Pdivbint { size = bi; is_safe } ->
box_int dbg bi (safe_div_bi is_safe
(transl_unbox_int dbg env bi arg1)
[transl_unbox_int_low dbg env bi arg1;
transl_unbox_int_low dbg env bi arg2], dbg))
| Plslbint bi ->
- box_int dbg bi (Cop(Clsl,
- [transl_unbox_int_low dbg env bi arg1;
- untag_int(transl env arg2) dbg], dbg))
+ box_int dbg bi (lsl_int
+ (transl_unbox_int_low dbg env bi arg1)
+ (untag_int(transl env arg2) dbg) dbg)
| Plsrbint bi ->
- box_int dbg bi (Cop(Clsr,
- [make_unsigned_int bi (transl_unbox_int dbg env bi arg1)
- dbg;
- untag_int(transl env arg2) dbg], dbg))
+ box_int dbg bi (lsr_int
+ (make_unsigned_int bi (transl_unbox_int dbg env bi arg1)
+ dbg)
+ (untag_int(transl env arg2) dbg) dbg)
| Pasrbint bi ->
- box_int dbg bi (Cop(Casr,
- [transl_unbox_int dbg env bi arg1;
- untag_int(transl env arg2) dbg], dbg))
+ box_int dbg bi (asr_int
+ (transl_unbox_int dbg env bi arg1)
+ (untag_int(transl env arg2) dbg) dbg)
| Pbintcomp(bi, cmp) ->
tag_int (Cop(Ccmpi cmp,
[transl_unbox_int dbg env bi arg1;
(then_dbg : Debuginfo.t) then_
(else_dbg : Debuginfo.t) else_ =
match cond with
- | Uconst (Uconst_ptr 0) -> else_
- | Uconst (Uconst_ptr 1) -> then_
- | Uifthenelse (arg1, arg2, Uconst (Uconst_ptr 0)) ->
+ | Uconst (Uconst_int 0) -> else_
+ | Uconst (Uconst_int 1) -> then_
+ | Uifthenelse (arg1, arg2, Uconst (Uconst_int 0)) ->
(* CR mshinwell: These Debuginfos will flow through from Clambda *)
let inner_dbg = Debuginfo.none in
let ifso_dbg = Debuginfo.none in
inner_dbg arg2
then_dbg then_
else_dbg else_
- | Uifthenelse (arg1, Uconst (Uconst_ptr 1), arg2) ->
+ | Uifthenelse (arg1, Uconst (Uconst_int 1), arg2) ->
let inner_dbg = Debuginfo.none in
let ifnot_dbg = Debuginfo.none in
transl_sequor env approx
dbg arg
else_dbg else_
then_dbg then_
- | Uifthenelse (Uconst (Uconst_ptr 1), ifso, _) ->
+ | Uifthenelse (Uconst (Uconst_int 1), ifso, _) ->
let ifso_dbg = Debuginfo.none in
transl_if env approx
ifso_dbg ifso
then_dbg then_
else_dbg else_
- | Uifthenelse (Uconst (Uconst_ptr 0), _, ifnot) ->
+ | Uifthenelse (Uconst (Uconst_int 0), _, ifnot) ->
let ifnot_dbg = Debuginfo.none in
transl_if env approx
ifnot_dbg ifnot
bindings
in
let op_alloc prim args =
- Cop(Cextcall(prim, typ_val, true, None), args, dbg) in
+ Cop(Cextcall(prim, typ_val, [], true), args, dbg) in
let rec init_blocks = function
| [] -> fill_nonrec bsz
| (id, _exp, RHS_block sz) :: rem ->
| [] -> cont
| (id, exp, (RHS_block _ | RHS_infix _ | RHS_floatblock _)) :: rem ->
let op =
- Cop(Cextcall("caml_update_dummy", typ_void, false, None),
+ Cop(Cextcall("caml_update_dummy", typ_void, [], false),
[Cvar (VP.var id); transl env exp], dbg) in
Csequence(op, fill_blocks rem)
| (_id, _exp, RHS_nonrec) :: rem ->
)
l
+let add_structured_constant sym cst =
+ Hashtbl.replace state.structured_constants sym cst
+
let get_structured_constant s =
Hashtbl.find_opt state.structured_constants s
val set_structured_constants : Clambda.preallocated_constant list -> unit
+val add_structured_constant : string -> Clambda.ustructured_constant -> unit
+
(* Also looks up using Compilenv.structured_constant_of_symbol *)
val structured_constant_of_sym : string -> Clambda.ustructured_constant option
else instr_cons_debug (Iop(Iintop_imm(Iadd, offset))) i.res
i.res i.dbg next
in
- (instr_cons_debug (Iop(Ialloc {bytes = totalsz; spacetime_index = 0;
- dbginfo; label_after_call_gc = None; }))
+ (instr_cons_debug (Iop(Ialloc {bytes = totalsz; dbginfo; }))
i.arg i.res i.dbg next, allocstate)
end
- | Iop(Icall_ind _ | Icall_imm _ | Iextcall _ |
- Itailcall_ind _ | Itailcall_imm _) ->
+ | Iop(Icall_ind | Icall_imm _ | Iextcall _ |
+ Itailcall_ind | Itailcall_imm _) ->
let newnext = combine_restart i.next in
(instr_cons_debug i.desc i.arg i.res i.dbg newnext,
allocstate)
let (newi, _) = combine i No_alloc in newi
let fundecl f =
- if Config.spacetime then f
- else {f with fun_body = combine_restart f.fun_body}
+ {f with fun_body = combine_restart f.fun_body}
| _ -> append a b
let rec deadcode i =
- let arg =
- if Config.spacetime
- && Mach.spacetime_node_hole_pointer_is_live_before i
- then Array.append i.arg [| Proc.loc_spacetime_node_hole |]
- else i.arg
- in
match i.desc with
- | Iend | Ireturn | Iop(Itailcall_ind _) | Iop(Itailcall_imm _) | Iraise _ ->
- let regs = Reg.add_set_array i.live arg in
+ | Iend | Ireturn | Iop(Itailcall_ind) | Iop(Itailcall_imm _) | Iraise _ ->
+ let regs = Reg.add_set_array i.live i.arg in
{ i; regs; exits = Int.Set.empty; }
| Iop op ->
let s = deadcode i.next in
if Proc.op_is_pure op (* no side effects *)
&& Reg.disjoint_set_array s.regs i.res (* results are not used after *)
- && not (Proc.regs_are_volatile arg) (* no stack-like hard reg *)
+ && not (Proc.regs_are_volatile i.arg) (* no stack-like hard reg *)
&& not (Proc.regs_are_volatile i.res) (* is involved *)
then begin
assert (Array.length i.res > 0); (* sanity check *)
s
end else begin
{ i = {i with next = s.i};
- regs = Reg.add_set_array i.live arg;
+ regs = Reg.add_set_array i.live i.arg;
exits = s.exits;
}
end
let ifnot' = deadcode ifnot in
let s = deadcode i.next in
{ i = {i with desc = Iifthenelse(test, ifso'.i, ifnot'.i); next = s.i};
- regs = Reg.add_set_array i.live arg;
+ regs = Reg.add_set_array i.live i.arg;
exits = Int.Set.union s.exits
(Int.Set.union ifso'.exits ifnot'.exits);
}
let cases' = Array.map (fun c -> c.i) dc in
let s = deadcode i.next in
{ i = {i with desc = Iswitch(index, cases'); next = s.i};
- regs = Reg.add_set_array i.live arg;
+ regs = Reg.add_set_array i.live i.arg;
exits = Array.fold_left
(fun acc c -> Int.Set.union acc c.exits) s.exits dc;
}
match instr.desc with
| Iend -> None, ok avail_before
| Ireturn -> None, unreachable
- | Iop (Itailcall_ind _) | Iop (Itailcall_imm _) ->
+ | Iop (Itailcall_ind) | Iop (Itailcall_imm _) ->
Some (ok Reg_with_debug_info.Set.empty), unreachable
| Iop (Iname_for_debugger { ident; which_parameter; provenance;
is_assignment; }) ->
[Available_ranges.Make_ranges.end_pos_offset]. *)
let made_unavailable_2 =
match op with
- | Icall_ind _ | Icall_imm _ | Ialloc _ ->
+ | Icall_ind | Icall_imm _ | Ialloc _ ->
RD.Set.filter (fun reg ->
let holds_immediate = RD.holds_non_pointer reg in
let on_stack = RD.assigned_to_stack reg in
| Dbg_other d | Dbg_raise d ->
if Debuginfo.is_none d then 0 else 1
| Dbg_alloc dbgs ->
- if !Clflags.debug && not Config.spacetime &&
+ if !Clflags.debug &&
List.exists (fun d ->
not (Debuginfo.is_none d.Debuginfo.alloc_dbg)) dbgs
then 3 else 2
and float_operation =
Ifloatadd | Ifloatsub | Ifloatsubrev | Ifloatmul | Ifloatdiv | Ifloatdivrev
-let spacetime_node_hole_pointer_is_live_before _specific_op = false
-
(* Sizes, endianness *)
let big_endian = false
(* Record live pointers at call points *)
-let record_frame_label ?label live dbg =
- let lbl =
- match label with
- | None -> new_label()
- | Some label -> label
- in
+let record_frame_label live dbg =
+ let lbl = new_label () in
let live_offset = ref [] in
Reg.Set.iter
(function
~live_offset:!live_offset dbg;
lbl
-let record_frame ?label live dbg =
- let lbl = record_frame_label ?label live dbg in
+let record_frame live dbg =
+ let lbl = record_frame_label live dbg in
def_label lbl
(* Record calls to the GC -- we've moved them out of the way *)
let bound_error_sites = ref ([] : bound_error_call list)
let bound_error_call = ref 0
-let bound_error_label ?label dbg =
+let bound_error_label dbg =
if !Clflags.debug then begin
let lbl_bound_error = new_label() in
- let lbl_frame = record_frame_label ?label Reg.Set.empty (Dbg_other dbg) in
+ let lbl_frame = record_frame_label Reg.Set.empty (Dbg_other dbg) in
bound_error_sites :=
{ bd_lbl = lbl_bound_error; bd_frame = lbl_frame } :: !bound_error_sites;
lbl_bound_error
| Lop(Iconst_symbol s) ->
add_used_symbol s;
I.mov (immsym s) (reg i.res.(0))
- | Lop(Icall_ind { label_after; }) ->
+ | Lop(Icall_ind) ->
I.call (reg i.arg.(0));
- record_frame i.live (Dbg_other i.dbg) ~label:label_after
- | Lop(Icall_imm { func; label_after; }) ->
+ record_frame i.live (Dbg_other i.dbg)
+ | Lop(Icall_imm { func; }) ->
add_used_symbol func;
emit_call func;
- record_frame i.live (Dbg_other i.dbg) ~label:label_after
- | Lop(Itailcall_ind { label_after = _; }) ->
- output_epilogue begin fun () ->
- I.jmp (reg i.arg.(0))
- end
- | Lop(Itailcall_imm { func; label_after = _; }) ->
+ record_frame i.live (Dbg_other i.dbg)
+ | Lop(Itailcall_ind) ->
+ output_epilogue (fun () -> I.jmp (reg i.arg.(0)))
+ | Lop(Itailcall_imm { func; }) ->
if func = !function_name then
I.jmp (label !tailrec_entry_point)
else begin
I.jmp (immsym func)
end
end
- | Lop(Iextcall { func; alloc; label_after; }) ->
+ | Lop(Iextcall { func; alloc; }) ->
add_used_symbol func;
if alloc then begin
I.mov (immsym func) eax;
emit_call "caml_c_call";
- record_frame i.live (Dbg_other i.dbg) ~label:label_after
+ record_frame i.live (Dbg_other i.dbg)
end else begin
emit_call func
end
I.fstp (addressing addr REAL8 i 1)
end
end
- | Lop(Ialloc { bytes = n; label_after_call_gc; dbginfo }) ->
+ | Lop(Ialloc { bytes = n; dbginfo }) ->
if !fastcode_flag then begin
load_domain_state ebx;
I.mov (domain_field Domain_young_ptr RBX) eax;
I.cmp (domain_field Domain_young_limit RBX) eax;
let lbl_call_gc = new_label() in
let lbl_frame =
- record_frame_label ?label:label_after_call_gc
+ record_frame_label
i.live (Dbg_alloc dbginfo) in
I.jb (label lbl_call_gc);
let lbl_after_alloc = new_label() in
emit_call "caml_allocN"
end;
let label =
- record_frame_label ?label:label_after_call_gc
+ record_frame_label
i.live (Dbg_alloc dbginfo)
in
def_label label;
I.cmp (int n) (reg i.arg.(0));
I.set (cond cmp) al;
I.movzx al (reg i.res.(0))
- | Lop(Iintop (Icheckbound { label_after_error; } )) ->
- let lbl = bound_error_label ?label:label_after_error i.dbg in
+ | Lop(Iintop (Icheckbound)) ->
+ let lbl = bound_error_label i.dbg in
I.cmp (reg i.arg.(1)) (reg i.arg.(0));
I.jbe (label lbl)
- | Lop(Iintop_imm(Icheckbound { label_after_error; }, n)) ->
- let lbl = bound_error_label ?label:label_after_error i.dbg in
+ | Lop(Iintop_imm(Icheckbound, n)) ->
+ let lbl = bound_error_label i.dbg in
I.cmp (int n) (reg i.arg.(0));
I.jbe (label lbl)
| Lop(Iintop(Idiv | Imod)) ->
let stack_slot slot ty =
Reg.at_location ty (Stack slot)
-let loc_spacetime_node_hole = Reg.dummy (* Spacetime unsupported *)
-
(* Instruction selection *)
let word_addressed = false
let float = ref first_float in
let ofs = ref (-64) in
for i = 0 to Array.length arg - 1 do
- match arg.(i).typ with
+ match arg.(i) with
Val | Int | Addr as ty ->
if !int <= last_int then begin
loc.(i) <- phys_reg !int;
fatal_error "Proc.loc_external_arguments"
let loc_external_results res =
match res with
- | [|{typ=Int};{typ=Int}|] -> [|eax; edx|]
+ | [| Int; Int |] -> [|eax; edx|]
| _ ->
let (loc, _ofs) = calling_conventions 0 0 100 100 not_supported res in loc
[|eax; ecx; edx|]
let destroyed_at_oper = function
- Iop(Icall_ind _ | Icall_imm _ | Iextcall { alloc = true; _}) ->
+ Iop(Icall_ind | Icall_imm _ | Iextcall { alloc = true; _}) ->
all_phys_regs
| Iop(Iextcall { alloc = false; }) -> destroyed_at_c_call
| Iop(Iintop(Idiv | Imod)) -> [| eax; edx |]
registers). *)
let op_is_pure = function
- | Icall_ind _ | Icall_imm _ | Itailcall_ind _ | Itailcall_imm _
+ | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
| Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
- | Iintop(Icheckbound _) | Iintop_imm(Icheckbound _, _) -> false
+ | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _) -> false
| Ispecific(Ilea _) -> true
| Ispecific _ -> false
| _ -> true
method! reload_operation op arg res =
match op with
- Iintop(Iadd|Isub|Iand|Ior|Ixor|Icomp _|Icheckbound _) ->
+ Iintop(Iadd|Isub|Iand|Ior|Ixor|Icomp _|Icheckbound) ->
(* One of the two arguments can reside in the stack *)
if stackp arg.(0) && stackp arg.(1)
then ([|arg.(0); self#makereg arg.(1)|], res)
let n1 = float_needs arg1 in
let n2 = float_needs arg2 in
if n1 = n2 then 1 + n1 else if n1 > n2 then n1 else n2
- | Cop(Cextcall(fn, _ty_res, _alloc, _label), args, _dbg)
+ | Cop(Cextcall(fn, _ty_res, _ty_args, _alloc), args, _dbg)
when !fast_math && List.mem fn inline_float_ops ->
begin match args with
[arg] -> float_needs arg
inherit Selectgen.selector_generic as super
-method is_immediate (_n : int) = true
+method! is_immediate op n =
+ match op with
+ | Iadd | Isub | Imul | Iand | Ior | Ixor | Icomp _ | Icheckbound ->
+ true
+ | _ ->
+ super#is_immediate op n
+
+method is_immediate_test _cmp _n = true
method! is_simple_expr e =
match e with
- | Cop(Cextcall(fn, _, _alloc, _), args, _)
+ | Cop(Cextcall(fn, _, _, _), args, _)
when !fast_math && List.mem fn inline_float_ops ->
(* inlined float ops are simple if their arguments are *)
List.for_all self#is_simple_expr args
match exp with
Cconst_int (n, _) ->
(Ispecific(Istore_int(Nativeint.of_int n, addr, is_assign)), Ctuple [])
- | (Cconst_natint (n, _) | Cblockheader (n, _)) ->
- (Ispecific(Istore_int(n, addr, is_assign)), Ctuple [])
- | Cconst_pointer (n, _) ->
- (Ispecific(Istore_int(Nativeint.of_int n, addr, is_assign)), Ctuple [])
- | Cconst_natpointer (n, _) ->
+ | Cconst_natint (n, _) ->
(Ispecific(Istore_int(n, addr, is_assign)), Ctuple [])
| Cconst_symbol (s, _) ->
(Ispecific(Istore_symbol(s, addr, is_assign)), Ctuple [])
super#select_operation op args dbg
end
(* Recognize inlined floating point operations *)
- | Cextcall(fn, _ty_res, false, _label)
+ | Cextcall(fn, _ty_res, _ty_args, false)
when !fast_math && List.mem fn inline_float_ops ->
(Ispecific(Ifloatspecial fn), args)
- (* i386 does not support immediate operands for multiply high signed *)
- | Cmulhi ->
- (Iintop Imulh, args)
(* Default *)
| _ -> super#select_operation op args dbg
match exp with
Cconst_int (n, _) -> (Ispecific(Ipush_int(Nativeint.of_int n)), Ctuple [])
| Cconst_natint (n, _) -> (Ispecific(Ipush_int n), Ctuple [])
- | Cconst_pointer (n, _) ->
- (Ispecific(Ipush_int(Nativeint.of_int n)), Ctuple [])
- | Cconst_natpointer (n, _) -> (Ispecific(Ipush_int n), Ctuple [])
| Cconst_symbol (s, _) -> (Ispecific(Ipush_symbol s), Ctuple [])
| Cop(Cload ((Word_int | Word_val as chunk), _), [loc], _) ->
let (addr, arg) = self#select_addressing chunk loc in
method! mark_c_tailcall =
contains_calls := true
-method! emit_extcall_args env args =
+method! emit_extcall_args env _ty_args args =
let rec size_pushes = function
| [] -> 0
| e :: el -> Selectgen.size_expr env e + size_pushes el in
| Iop(Imove | Ispill | Ireload) ->
add_interf_move i.arg.(0) i.res.(0) i.live;
interf i.next
- | Iop(Itailcall_ind _) -> ()
+ | Iop(Itailcall_ind) -> ()
| Iop(Itailcall_imm _) -> ()
| Iop _ ->
add_interf_set i.res i.live;
| Iop(Ireload) ->
add_pref (weight / 4) i.res.(0) i.arg.(0);
prefer weight i.next
- | Iop(Itailcall_ind _) -> ()
+ | Iop(Itailcall_ind) -> ()
| Iop(Itailcall_imm _) -> ()
| Iop _ ->
prefer weight i.next
update_interval_position_by_instr intervals i !pos;
begin match i.desc with
Iend -> ()
- | Iop(Icall_ind _ | Icall_imm _ | Iextcall{alloc = true; _}
- | Itailcall_ind _ | Itailcall_imm _) ->
+ | Iop(Icall_ind | Icall_imm _ | Iextcall{alloc = true; _}
+ | Itailcall_ind | Itailcall_imm _) ->
walk_instruction i.next
| Iop _ ->
insert_destroyed_at_oper intervals i !pos;
let has_fallthrough = function
| Lreturn | Lbranch _ | Lswitch _ | Lraise _
- | Lop Itailcall_ind _ | Lop (Itailcall_imm _) -> false
+ | Lop Itailcall_ind | Lop (Itailcall_imm _) -> false
| _ -> true
type fundecl =
fun_body: instruction;
fun_fast: bool;
fun_dbg : Debuginfo.t;
- fun_spacetime_shape : Mach.spacetime_shape option;
fun_tailrec_entry_point_label : label;
fun_contains_calls: bool;
fun_num_stack_slots: int array;
fun_body: instruction;
fun_fast: bool;
fun_dbg : Debuginfo.t;
- fun_spacetime_shape : Mach.spacetime_shape option;
fun_tailrec_entry_point_label : label;
fun_contains_calls: bool;
fun_num_stack_slots: int array;
let rec linear i n =
match i.Mach.desc with
Iend -> n
- | Iop(Itailcall_ind _ | Itailcall_imm _ as op) ->
- if not Config.spacetime then
- copy_instr (Lop op) i (discard_dead_code n)
- else
- copy_instr (Lop op) i (linear i.Mach.next n)
+ | Iop(Itailcall_ind | Itailcall_imm _ as op) ->
+ copy_instr (Lop op) i (discard_dead_code n)
| Iop(Imove | Ireload | Ispill)
when i.Mach.arg.(0).loc = i.Mach.res.(0).loc ->
linear i.Mach.next n
get_label (cons_instr Lentertrap (linear handler n1))
in
incr try_depth;
- assert (i.Mach.arg = [| |] || Config.spacetime);
+ assert (i.Mach.arg = [| |]);
let n3 = cons_instr (Lpushtrap { lbl_handler; })
(linear body
(cons_instr
fun_body;
fun_fast = not (List.mem Cmm.Reduce_code_size f.Mach.fun_codegen_options);
fun_dbg = f.Mach.fun_dbg;
- fun_spacetime_shape = f.Mach.fun_spacetime_shape;
fun_tailrec_entry_point_label;
fun_contains_calls = contains_calls;
fun_num_stack_slots = f.Mach.fun_num_stack_slots;
before the instruction sequence.
The instruction i is annotated by the set of registers live across
the instruction. *)
- let arg =
- if Config.spacetime
- && Mach.spacetime_node_hole_pointer_is_live_before i
- then Array.append i.arg [| Proc.loc_spacetime_node_hole |]
- else i.arg
- in
match i.desc with
Iend ->
i.live <- finally;
finally
- | Ireturn | Iop(Itailcall_ind _) | Iop(Itailcall_imm _) ->
+ | Ireturn | Iop(Itailcall_ind) | Iop(Itailcall_imm _) ->
i.live <- Reg.Set.empty; (* no regs are live across *)
- Reg.set_of_array arg
+ Reg.set_of_array i.arg
| Iop op ->
let after = live i.next finally in
if Proc.op_is_pure op (* no side effects *)
&& Reg.disjoint_set_array after i.res (* results are not used after *)
- && not (Proc.regs_are_volatile arg) (* no stack-like hard reg *)
+ && not (Proc.regs_are_volatile i.arg) (* no stack-like hard reg *)
&& not (Proc.regs_are_volatile i.res) (* is involved *)
then begin
(* This operation is dead code. Ignore its arguments. *)
let across_after = Reg.diff_set_array after i.res in
let across =
match op with
- | Icall_ind _ | Icall_imm _ | Iextcall _ | Ialloc _
- | Iintop (Icheckbound _) | Iintop_imm(Icheckbound _, _) ->
+ | Icall_ind | Icall_imm _ | Iextcall _ | Ialloc _
+ | Iintop (Icheckbound) | Iintop_imm(Icheckbound, _) ->
(* The function call may raise an exception, branching to the
nearest enclosing try ... with. Similarly for bounds checks
and allocation (for the latter: finalizers may throw
| _ ->
across_after in
i.live <- across;
- Reg.add_set_array across arg
+ Reg.add_set_array across i.arg
end
| Iifthenelse(_test, ifso, ifnot) ->
let at_join = live i.next finally in
let at_fork = Reg.Set.union (live ifso at_join) (live ifnot at_join) in
i.live <- at_fork;
- Reg.add_set_array at_fork arg
+ Reg.add_set_array at_fork i.arg
| Iswitch(_index, cases) ->
let at_join = live i.next finally in
let at_fork = ref Reg.Set.empty in
at_fork := Reg.Set.union !at_fork (live cases.(i) at_join)
done;
i.live <- !at_fork;
- Reg.add_set_array !at_fork arg
+ Reg.add_set_array !at_fork i.arg
| Icatch(rec_flag, handlers, body) ->
let at_join = live i.next finally in
let aux (nfail,handler) (nfail', before_handler) =
before_body
| Iraise _ ->
i.live <- !live_at_raise;
- Reg.add_set_array !live_at_raise arg
+ Reg.add_set_array !live_at_raise i.arg
let reset () =
live_at_raise := Reg.Set.empty;
let fundecl f =
let initially_live = live f.fun_body Reg.Set.empty in
- (* Sanity check: only function parameters (and the Spacetime node hole
- register, if profiling) can be live at entrypoint *)
+ (* Sanity check: only function parameters can be live at entrypoint *)
let wrong_live = Reg.Set.diff initially_live (Reg.set_of_array f.fun_args) in
- let wrong_live =
- if not Config.spacetime then wrong_live
- else Reg.Set.remove Proc.loc_spacetime_node_hole wrong_live
- in
if not (Reg.Set.is_empty wrong_live) then begin
Misc.fatal_errorf "@[Liveness.fundecl:@\n%a@]"
Printmach.regset wrong_live
(* Representation of machine code by sequences of pseudoinstructions *)
-type label = Cmm.label
-
type integer_comparison =
Isigned of Cmm.integer_comparison
| Iunsigned of Cmm.integer_comparison
Iadd | Isub | Imul | Imulh | Idiv | Imod
| Iand | Ior | Ixor | Ilsl | Ilsr | Iasr
| Icomp of integer_comparison
- | Icheckbound of { label_after_error : label option;
- spacetime_index : int; }
+ | Icheckbound
type float_comparison = Cmm.float_comparison
| Iconst_int of nativeint
| Iconst_float of int64
| Iconst_symbol of string
- | Icall_ind of { label_after : label; }
- | Icall_imm of { func : string; label_after : label; }
- | Itailcall_ind of { label_after : label; }
- | Itailcall_imm of { func : string; label_after : label; }
- | Iextcall of { func : string; alloc : bool; label_after : label; }
+ | Icall_ind
+ | Icall_imm of { func : string; }
+ | Itailcall_ind
+ | Itailcall_imm of { func : string; }
+ | Iextcall of { func : string;
+ ty_res : Cmm.machtype; ty_args : Cmm.exttype list;
+ alloc : bool; }
| Istackoffset of int
| Iload of Cmm.memory_chunk * Arch.addressing_mode
| Istore of Cmm.memory_chunk * Arch.addressing_mode * bool
- | Ialloc of { bytes : int; label_after_call_gc : label option;
- dbginfo : Debuginfo.alloc_dbginfo; spacetime_index : int; }
+ | Ialloc of { bytes : int; dbginfo : Debuginfo.alloc_dbginfo; }
| Iintop of integer_operation
| Iintop_imm of integer_operation * int
| Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
| Itrywith of instruction * instruction
| Iraise of Lambda.raise_kind
-type spacetime_part_of_shape =
- | Direct_call_point of { callee : string; }
- | Indirect_call_point
- | Allocation_point
-
-type spacetime_shape = (spacetime_part_of_shape * Cmm.label) list
-
type fundecl =
{ fun_name: string;
fun_args: Reg.t array;
fun_body: instruction;
fun_codegen_options : Cmm.codegen_option list;
fun_dbg : Debuginfo.t;
- fun_spacetime_shape : spacetime_shape option;
fun_num_stack_slots: int array;
fun_contains_calls: bool;
}
f i;
match i.desc with
Iend -> ()
- | Ireturn | Iop(Itailcall_ind _) | Iop(Itailcall_imm _) -> ()
+ | Ireturn | Iop Itailcall_ind | Iop(Itailcall_imm _) -> ()
| Iifthenelse(_tst, ifso, ifnot) ->
instr_iter f ifso; instr_iter f ifnot; instr_iter f i.next
| Iswitch(_index, cases) ->
| _ ->
instr_iter f i.next
-let spacetime_node_hole_pointer_is_live_before insn =
- match insn.desc with
- | Iop op ->
- begin match op with
- | Icall_ind _ | Icall_imm _ | Itailcall_ind _ | Itailcall_imm _ -> true
- | Iextcall { alloc; } -> alloc
- | Ialloc _ ->
- (* Allocations are special: the call to [caml_call_gc] requires some
- instrumentation code immediately prior, but this is not inserted until
- the emitter (since the call is not visible prior to that in any IR).
- As such, none of the Mach / Linearize analyses will ever see that
- we use the node hole pointer for these, and we do not need to say
- that it is live at such points. *)
- false
- | Iintop op | Iintop_imm (op, _) ->
- begin match op with
- | Icheckbound _
- (* [Icheckbound] doesn't need to return [true] for the same reason as
- [Ialloc]. *)
- | Iadd | Isub | Imul | Imulh | Idiv | Imod
- | Iand | Ior | Ixor | Ilsl | Ilsr | Iasr
- | Icomp _ -> false
- end
- | Ispecific specific_op ->
- Arch.spacetime_node_hole_pointer_is_live_before specific_op
- | Imove | Ispill | Ireload | Iconst_int _ | Iconst_float _
- | Iconst_symbol _ | Istackoffset _ | Iload _ | Istore _
- | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
- | Ifloatofint | Iintoffloat
- | Iname_for_debugger _ -> false
- end
- | Iend | Ireturn | Iifthenelse _ | Iswitch _ | Icatch _
- | Iexit _ | Itrywith _ | Iraise _ -> false
-
let operation_can_raise op =
match op with
- | Icall_ind _ | Icall_imm _ | Iextcall _
- | Iintop (Icheckbound _) | Iintop_imm (Icheckbound _, _)
+ | Icall_ind | Icall_imm _ | Iextcall _
+ | Iintop (Icheckbound) | Iintop_imm (Icheckbound, _)
| Ialloc _ -> true
| _ -> false
(* Representation of machine code by sequences of pseudoinstructions *)
-(** N.B. Backends vary in their treatment of call gc and checkbound
- points. If the positioning of any labels associated with these is
- important for some new feature in the compiler, the relevant backends'
- behaviour should be checked. *)
-type label = Cmm.label
-
type integer_comparison =
Isigned of Cmm.integer_comparison
| Iunsigned of Cmm.integer_comparison
Iadd | Isub | Imul | Imulh | Idiv | Imod
| Iand | Ior | Ixor | Ilsl | Ilsr | Iasr
| Icomp of integer_comparison
- | Icheckbound of { label_after_error : label option;
- spacetime_index : int; }
- (** For Spacetime only, [Icheckbound] operations take two arguments, the
- second being the pointer to the trie node for the current function
- (and the first being as per non-Spacetime mode). *)
+ | Icheckbound
type float_comparison = Cmm.float_comparison
| Iconst_int of nativeint
| Iconst_float of int64
| Iconst_symbol of string
- | Icall_ind of { label_after : label; }
- | Icall_imm of { func : string; label_after : label; }
- | Itailcall_ind of { label_after : label; }
- | Itailcall_imm of { func : string; label_after : label; }
- | Iextcall of { func : string; alloc : bool; label_after : label; }
+ | Icall_ind
+ | Icall_imm of { func : string; }
+ | Itailcall_ind
+ | Itailcall_imm of { func : string; }
+ | Iextcall of { func : string;
+ ty_res : Cmm.machtype; ty_args : Cmm.exttype list;
+ alloc : bool; }
| Istackoffset of int
| Iload of Cmm.memory_chunk * Arch.addressing_mode
| Istore of Cmm.memory_chunk * Arch.addressing_mode * bool
(* false = initialization, true = assignment *)
- | Ialloc of { bytes : int; label_after_call_gc : label option;
- dbginfo : Debuginfo.alloc_dbginfo; spacetime_index : int; }
- (** For Spacetime only, Ialloc instructions take one argument, being the
- pointer to the trie node for the current function. *)
+ | Ialloc of { bytes : int; dbginfo : Debuginfo.alloc_dbginfo; }
| Iintop of integer_operation
| Iintop_imm of integer_operation * int
| Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
| Itrywith of instruction * instruction
| Iraise of Lambda.raise_kind
-type spacetime_part_of_shape =
- | Direct_call_point of { callee : string; (* the symbol *) }
- | Indirect_call_point
- | Allocation_point
-
-(** A description of the layout of a Spacetime profiling node associated with
- a given function. Each call and allocation point instrumented within
- the function is marked with a label in the code and assigned a place
- within the node. This information is stored within the executable and
- extracted when the user saves a profile. The aim is to minimise runtime
- memory usage within the nodes and increase performance. *)
-type spacetime_shape = (spacetime_part_of_shape * Cmm.label) list
-
type fundecl =
{ fun_name: string;
fun_args: Reg.t array;
fun_body: instruction;
fun_codegen_options : Cmm.codegen_option list;
fun_dbg : Debuginfo.t;
- fun_spacetime_shape : spacetime_shape option;
fun_num_stack_slots: int array;
fun_contains_calls: bool;
}
instruction -> instruction
val instr_iter: (instruction -> unit) -> instruction -> unit
-val spacetime_node_hole_pointer_is_live_before : instruction -> bool
-
val operation_can_raise : operation -> bool
Imultaddf (* multiply and add *)
| Imultsubf (* multiply and subtract *)
| Ialloc_far of (* allocation in large functions *)
- { bytes : int; label_after_call_gc : int (*Cmm.label*) option;
- dbginfo : Debuginfo.alloc_dbginfo }
-
-(* note: we avoid introducing a dependency to Cmm since this dep
- is not detected when "make depend" is run under amd64 *)
-
-let spacetime_node_hole_pointer_is_live_before = function
- | Imultaddf | Imultsubf -> false
- | Ialloc_far _ -> true
+ { bytes : int; dbginfo : Debuginfo.alloc_dbginfo }
(* Addressing modes *)
let contains_calls = ref false
+let initial_stack_offset () =
+ reserved_stack_space +
+ size_int * num_stack_slots.(0) + (* Local int variables *)
+ size_float * num_stack_slots.(1) + (* Local float variables *)
+ (if !contains_calls && abi = ELF32 then size_int else 0)
+ (* The return address *)
let frame_size () =
let size =
- reserved_stack_space +
!stack_offset + (* Trap frame, outgoing parameters *)
- size_int * num_stack_slots.(0) + (* Local int variables *)
- size_float * num_stack_slots.(1) + (* Local float variables *)
- (if !contains_calls && abi = ELF32 then size_int else 0) in
- (* The return address *)
+ initial_stack_offset () in
Misc.align size 16
let slot_offset loc cls =
(* Record live pointers at call points *)
-let record_frame ?label live dbg =
- let lbl =
- match label with
- | None -> new_label()
- | Some label -> label
- in
+let record_frame live dbg =
+ let lbl = new_label() in
let live_offset = ref [] in
Reg.Set.iter
(function
let prologue_size () =
profiling_prologue_size ()
- + (if frame_size () > 0 then 1 else 0)
+ + (if initial_stack_offset () > 0 then 1 else 0)
+ (if !contains_calls then
2 +
match abi with
else tocload_size()
| Lop(Iconst_float _) -> if abi = ELF32 then 2 else tocload_size()
| Lop(Iconst_symbol _) -> if abi = ELF32 then 2 else tocload_size()
- | Lop(Icall_ind _) -> size 2 5 4
+ | Lop(Icall_ind) -> size 2 5 4
| Lop(Icall_imm _) -> size 1 3 3
- | Lop(Itailcall_ind _) -> size 5 7 6
+ | Lop(Itailcall_ind) -> size 5 7 6
| Lop(Itailcall_imm { func; _ }) ->
if func = !function_name
then 1
| Lpoptrap -> 2
| Lraise _ -> 6
- let relax_allocation ~num_bytes:bytes ~label_after_call_gc ~dbginfo =
- Lop (Ispecific (Ialloc_far { bytes; label_after_call_gc; dbginfo }))
+ let relax_allocation ~num_bytes:bytes ~dbginfo =
+ Lop (Ispecific (Ialloc_far { bytes; dbginfo }))
(* [classify_addr], above, never identifies these instructions as needing
relaxing. As such, these functions should never be called. *)
let relax_specific_op _ = assert false
- let relax_intop_checkbound ~label_after_error:_ = assert false
- let relax_intop_imm_checkbound ~bound:_ ~label_after_error:_ = assert false
+ let relax_intop_checkbound () = assert false
+ let relax_intop_imm_checkbound ~bound:_ = assert false
end)
(* Output the assembly code for an instruction *)
| ELF64v1 | ELF64v2 ->
emit_tocload emit_reg i.res.(0) (TocSym s)
end
- | Lop(Icall_ind { label_after; }) ->
+ | Lop(Icall_ind) ->
begin match abi with
| ELF32 ->
` mtctr {emit_reg i.arg.(0)}\n`;
` bctrl\n`;
- record_frame i.live (Dbg_other i.dbg) ~label:label_after
+ record_frame i.live (Dbg_other i.dbg)
| ELF64v1 ->
` ld 0, 0({emit_reg i.arg.(0)})\n`; (* code pointer *)
` mtctr 0\n`;
` ld 2, 8({emit_reg i.arg.(0)})\n`; (* TOC for callee *)
` bctrl\n`;
- record_frame i.live (Dbg_other i.dbg) ~label:label_after;
+ record_frame i.live (Dbg_other i.dbg);
emit_reload_toc()
| ELF64v2 ->
` mtctr {emit_reg i.arg.(0)}\n`;
` mr 12, {emit_reg i.arg.(0)}\n`; (* addr of fn in r12 *)
` bctrl\n`;
- record_frame i.live (Dbg_other i.dbg) ~label:label_after;
+ record_frame i.live (Dbg_other i.dbg);
emit_reload_toc()
end
- | Lop(Icall_imm { func; label_after; }) ->
+ | Lop(Icall_imm { func; }) ->
begin match abi with
| ELF32 ->
emit_call func;
- record_frame i.live (Dbg_other i.dbg) ~label:label_after
+ record_frame i.live (Dbg_other i.dbg)
| ELF64v1 | ELF64v2 ->
(* For PPC64, we cannot just emit a "bl s; nop" sequence, because
of the following scenario:
Cost: 3 instructions if same TOC, 7 if different TOC.
Let's try option 2. *)
emit_call func;
- record_frame i.live (Dbg_other i.dbg) ~label:label_after;
+ record_frame i.live (Dbg_other i.dbg);
` nop\n`;
emit_reload_toc()
end
- | Lop(Itailcall_ind { label_after = _; }) ->
+ | Lop(Itailcall_ind) ->
begin match abi with
| ELF32 ->
` mtctr {emit_reg i.arg.(0)}\n`
end;
emit_free_frame();
` bctr\n`
- | Lop(Itailcall_imm { func; label_after = _; }) ->
+ | Lop(Itailcall_imm { func; }) ->
if func = !function_name then
` b {emit_label !tailrec_entry_point}\n`
else begin
| Single -> "stfs"
| Double | Double_u -> "stfd" in
emit_load_store storeinstr addr i.arg 1 i.arg.(0)
- | Lop(Ialloc { bytes = n; label_after_call_gc; dbginfo }) ->
- if !call_gc_label = 0 then begin
- match label_after_call_gc with
- | None -> call_gc_label := new_label ()
- | Some label -> call_gc_label := label
- end;
+ | Lop(Ialloc { bytes = n; dbginfo }) ->
+ if !call_gc_label = 0 then call_gc_label := new_label ();
` addi 31, 31, {emit_int(-n)}\n`;
` {emit_string cmplg} 31, 30\n`;
` bltl {emit_label !call_gc_label}\n`;
record_frame i.live (Dbg_alloc dbginfo);
` addi {emit_reg i.res.(0)}, 31, {emit_int size_addr}\n`;
- | Lop(Ispecific(Ialloc_far { bytes = n; label_after_call_gc; dbginfo })) ->
- if !call_gc_label = 0 then begin
- match label_after_call_gc with
- | None -> call_gc_label := new_label ()
- | Some label -> call_gc_label := label
- end;
+ | Lop(Ispecific(Ialloc_far { bytes = n; dbginfo })) ->
+ if !call_gc_label = 0 then call_gc_label := new_label ();
let lbl = new_label() in
` addi 31, 31, {emit_int(-n)}\n`;
` {emit_string cmplg} 31, 30\n`;
` {emit_string cmplg} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
emit_set_comp c i.res.(0)
end
- | Lop(Iintop (Icheckbound { label_after_error; })) ->
+ | Lop(Iintop (Icheckbound)) ->
if !Clflags.debug then
- record_frame Reg.Set.empty (Dbg_other i.dbg) ?label:label_after_error;
+ record_frame Reg.Set.empty (Dbg_other i.dbg);
` {emit_string tglle} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
| Lop(Iintop op) ->
let instr = name_for_intop op in
` {emit_string cmplg}i {emit_reg i.arg.(0)}, {emit_int n}\n`;
emit_set_comp c i.res.(0)
end
- | Lop(Iintop_imm(Icheckbound { label_after_error; }, n)) ->
+ | Lop(Iintop_imm(Icheckbound, n)) ->
if !Clflags.debug then
- record_frame Reg.Set.empty (Dbg_other i.dbg) ?label:label_after_error;
+ record_frame Reg.Set.empty (Dbg_other i.dbg);
` {emit_string tglle}i {emit_reg i.arg.(0)}, {emit_int n}\n`
| Lop(Iintop_imm(op, n)) ->
let instr = name_for_intop_imm op in
let stack_slot slot ty =
Reg.at_location ty (Stack slot)
-let loc_spacetime_node_hole = Reg.dummy (* Spacetime unsupported *)
-
(* Calling conventions *)
-let calling_conventions
- first_int last_int first_float last_float
- make_stack stack_ofs reg_use_stack arg =
- let loc = Array.make (Array.length arg) [| Reg.dummy |] in
+let loc_int last_int make_stack reg_use_stack int ofs =
+ if !int <= last_int then begin
+ let l = phys_reg !int in
+ incr int;
+ if reg_use_stack then ofs := !ofs + size_int;
+ l
+ end else begin
+ let l = stack_slot (make_stack !ofs) Int in
+ ofs := !ofs + size_int; l
+ end
+
+let loc_float last_float make_stack reg_use_stack int float ofs =
+ if !float <= last_float then begin
+ let l = phys_reg !float in
+ incr float;
+ (* On 64-bit platforms, passing a float in a float register
+ reserves a normal register as well *)
+ if size_int = 8 then incr int;
+ if reg_use_stack then ofs := !ofs + size_float;
+ l
+ end else begin
+ ofs := Misc.align !ofs size_float;
+ let l = stack_slot (make_stack !ofs) Float in
+ ofs := !ofs + size_float; l
+ end
+
+let loc_int_pair last_int make_stack int ofs =
+ (* 64-bit quantities split across two registers must either be in a
+ consecutive pair of registers where the lowest numbered is an
+ even-numbered register; or in a stack slot that is 8-byte aligned. *)
+ int := Misc.align !int 2;
+ if !int <= last_int - 1 then begin
+ let reg_lower = phys_reg !int in
+ let reg_upper = phys_reg (1 + !int) in
+ int := !int + 2;
+ [| reg_lower; reg_upper |]
+ end else begin
+ ofs := Misc.align !ofs 8;
+ let stack_lower = stack_slot (make_stack !ofs) Int in
+ let stack_upper = stack_slot (make_stack (size_int + !ofs)) Int in
+ ofs := !ofs + 8;
+ [| stack_lower; stack_upper |]
+ end
+
+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 stack_ofs in
+ let ofs = ref 0 in
for i = 0 to Array.length arg - 1 do
match arg.(i) with
- | [| arg |] ->
- begin match arg.typ with
- | Val | Int | Addr as ty ->
- if !int <= last_int then begin
- loc.(i) <- [| phys_reg !int |];
- incr int;
- if reg_use_stack then ofs := !ofs + size_int
- end else begin
- loc.(i) <- [| stack_slot (make_stack !ofs) ty |];
- ofs := !ofs + size_int
- end
- | Float ->
- if !float <= last_float then begin
- loc.(i) <- [| phys_reg !float |];
- incr float;
- (* On 64-bit platforms, passing a float in a float register
- reserves a normal register as well *)
- if size_int = 8 then incr int;
- if reg_use_stack then ofs := !ofs + size_float
- end else begin
- ofs := Misc.align !ofs size_float;
- loc.(i) <- [| stack_slot (make_stack !ofs) Float |];
- ofs := !ofs + size_float
- end
- end
- | [| arg1; arg2 |] ->
- (* Passing of 64-bit quantities to external functions
- on 32-bit platform. *)
- assert (size_int = 4);
- begin match arg1.typ, arg2.typ with
- | Int, Int ->
- (* 64-bit quantities split across two registers must either be in a
- consecutive pair of registers where the lowest numbered is an
- even-numbered register; or in a stack slot that is 8-byte
- aligned. *)
- int := Misc.align !int 2;
- if !int <= last_int - 1 then begin
- let reg_lower = phys_reg !int in
- let reg_upper = phys_reg (!int + 1) in
- loc.(i) <- [| reg_lower; reg_upper |];
- int := !int + 2
- end else begin
- let size_int64 = 8 in
- ofs := Misc.align !ofs size_int64;
- let ofs_lower = !ofs in
- let ofs_upper = !ofs + size_int in
- let stack_lower = stack_slot (make_stack ofs_lower) Int in
- let stack_upper = stack_slot (make_stack ofs_upper) Int in
- loc.(i) <- [| stack_lower; stack_upper |];
- ofs := !ofs + size_int64
- end
- | _, _ ->
- let f = function Int -> "I" | Addr -> "A" | Val -> "V" | Float -> "F" in
- fatal_error (Printf.sprintf "Proc.calling_conventions: bad register \
- type(s) for multi-register argument: %s, %s"
- (f arg1.typ) (f arg2.typ))
- end
- | _ ->
- fatal_error "Proc.calling_conventions: bad number of registers for \
- multi-register argument"
+ | Val | Int | Addr ->
+ loc.(i) <- loc_int last_int make_stack false int ofs
+ | Float ->
+ loc.(i) <- loc_float last_float make_stack false int float ofs
done;
- (loc, Misc.align !ofs 16)
- (* Keep stack 16-aligned. *)
+ (loc, Misc.align !ofs 16) (* keep stack 16-aligned *)
let incoming ofs = Incoming ofs
let outgoing ofs = Outgoing ofs
let not_supported _ofs = fatal_error "Proc.loc_results: cannot call"
-let single_regs arg = Array.map (fun arg -> [| arg |]) arg
-let ensure_single_regs res =
- Array.map (function
- | [| res |] -> res
- | _ -> failwith "Proc.ensure_single_regs")
- res
-
let max_arguments_for_tailcalls = 8
let loc_arguments arg =
- let (loc, ofs) =
- calling_conventions 0 7 100 112 outgoing 0 false (single_regs arg)
- in
- (ensure_single_regs loc, ofs)
+ calling_conventions 0 7 100 112 outgoing arg
+
let loc_parameters arg =
- let (loc, _ofs) =
- calling_conventions 0 7 100 112 incoming 0 false (single_regs arg)
- in
- ensure_single_regs loc
+ let (loc, _ofs) = calling_conventions 0 7 100 112 incoming arg
+ in loc
+
let loc_results res =
- let (loc, _ofs) =
- calling_conventions 0 7 100 112 not_supported 0 false (single_regs res)
- in
- ensure_single_regs loc
+ let (loc, _ofs) = calling_conventions 0 7 100 112 not_supported res
+ in loc
(* C calling conventions for ELF32:
use GPR 3-10 and FPR 1-8 just like ML calling conventions.
and need not appear here.
*)
-let loc_external_arguments =
+let external_calling_conventions
+ first_int last_int first_float last_float
+ make_stack stack_ofs reg_use_stack ty_args =
+ let loc = Array.make (List.length ty_args) [| Reg.dummy |] in
+ let int = ref first_int in
+ let float = ref first_float in
+ let ofs = ref stack_ofs in
+ List.iteri
+ (fun i ty_arg ->
+ match ty_arg with
+ | XInt | XInt32 ->
+ loc.(i) <-
+ [| loc_int last_int make_stack reg_use_stack int ofs |]
+ | XInt64 ->
+ if size_int = 4 then begin
+ assert (not reg_use_stack);
+ loc.(i) <- loc_int_pair last_int make_stack int ofs
+ end else
+ loc.(i) <-
+ [| loc_int last_int make_stack reg_use_stack int ofs |]
+ | XFloat ->
+ loc.(i) <-
+ [| loc_float last_float make_stack reg_use_stack int float ofs |])
+ ty_args;
+ (loc, Misc.align !ofs 16) (* Keep stack 16-aligned *)
+
+let loc_external_arguments ty_args =
match abi with
| ELF32 ->
- calling_conventions 0 7 100 107 outgoing 8 false
+ external_calling_conventions 0 7 100 107 outgoing 8 false ty_args
| ELF64v1 ->
- fun args ->
let (loc, ofs) =
- calling_conventions 0 7 100 112 outgoing 0 true args in
+ external_calling_conventions 0 7 100 112 outgoing 0 true ty_args in
(loc, max ofs 64)
| ELF64v2 ->
- fun args ->
let (loc, ofs) =
- calling_conventions 0 7 100 112 outgoing 0 true args in
+ external_calling_conventions 0 7 100 112 outgoing 0 true ty_args in
if Array.fold_left
(fun stk r ->
assert (Array.length r = 1);
(* Results are in GPR 3 and FPR 1 *)
let loc_external_results res =
- let (loc, _ofs) =
- calling_conventions 0 1 100 100 not_supported 0 false (single_regs res)
- in
- ensure_single_regs loc
+ let (loc, _ofs) = calling_conventions 0 1 100 100 not_supported res
+ in loc
(* Exceptions are in GPR 3 *)
100; 101; 102; 103; 104; 105; 106; 107; 108; 109; 110; 111; 112])
let destroyed_at_oper = function
- Iop(Icall_ind _ | Icall_imm _ | Iextcall { alloc = true; _ }) ->
+ Iop(Icall_ind | Icall_imm _ | Iextcall { alloc = true; _ }) ->
all_phys_regs
| Iop(Iextcall { alloc = false; _ }) -> destroyed_at_c_call
| _ -> [||]
registers). *)
let op_is_pure = function
- | Icall_ind _ | Icall_imm _ | Itailcall_ind _ | Itailcall_imm _
+ | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
| Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
- | Iintop(Icheckbound _) | Iintop_imm(Icheckbound _, _) -> false
+ | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _) -> false
| Ispecific(Imultaddf | Imultsubf) -> true
| Ispecific _ -> false
| _ -> true
| exp ->
(Alinear exp, 0, Debuginfo.none)
+let is_immediate n = n <= 0x7FFF && n >= -0x8000
+let is_immediate_logical n = n <= 0xFFFF && n >= 0
+
(* Instruction selection *)
class selector = object (self)
inherit Selectgen.selector_generic as super
-method is_immediate n = (n <= 32767) && (n >= -32768)
+method is_immediate_test cmp n =
+ match cmp with
+ | Isigned _ -> is_immediate n
+ | Iunsigned _ -> is_immediate_logical n
+
+method! is_immediate op n =
+ match op with
+ | Iadd | Imul -> is_immediate n
+ | Isub -> is_immediate (-n) (* turned into add opposite *)
+ | Iand | Ior | Ixor -> is_immediate_logical n
+ | Icomp c -> self#is_immediate_test c n
+ | Icheckbound -> 0 <= n && n <= 0x7FFF
+ (* twlle takes a 16-bit signed immediate but performs an unsigned compare *)
+ | _ -> super#is_immediate op n
method select_addressing _chunk exp =
match select_addr exp with
method! select_operation op args dbg =
match (op, args) with
- (* PowerPC does not support immediate operands for multiply high *)
- (Cmulhi, _) -> (Iintop Imulh, args)
- (* The and, or and xor instructions have a different range of immediate
- operands than the other instructions *)
- | (Cand, _) -> self#select_logical Iand args
- | (Cor, _) -> self#select_logical Ior args
- | (Cxor, _) -> self#select_logical Ixor args
(* Recognize mult-add and mult-sub instructions *)
| (Caddf, [Cop(Cmulf, [arg1; arg2], _); arg3]) ->
(Ispecific Imultaddf, [arg1; arg2; arg3])
| _ ->
super#select_operation op args dbg
-method select_logical op = function
- [arg; Cconst_int (n, _)] when n >= 0 && n <= 0xFFFF ->
- (Iintop_imm(op, n), [arg])
- | [Cconst_int (n, _); arg] when n >= 0 && n <= 0xFFFF ->
- (Iintop_imm(op, n), [arg])
- | args ->
- (Iintop op, args)
-
end
let fundecl f = (new selector)#emit_fundecl f
fprintf ppf "*%a" machtype_component mty.(i)
done
+let exttype ppf = function
+ | XInt -> fprintf ppf "int"
+ | XInt32 -> fprintf ppf "int32"
+ | XInt64 -> fprintf ppf "int64"
+ | XFloat -> fprintf ppf "float"
+
+let extcall_signature ppf (ty_res, ty_args) =
+ begin match ty_args with
+ | [] -> ()
+ | ty_arg1 :: ty_args ->
+ exttype ppf ty_arg1;
+ List.iter (fun ty -> fprintf ppf ",%a" exttype ty) ty_args
+ end;
+ fprintf ppf "->%a" machtype ty_res
+
let integer_comparison = function
| Ceq -> "=="
| Cne -> "!="
let operation d = function
| Capply _ty -> "app" ^ location d
- | Cextcall(lbl, _ty, _alloc, _) ->
+ | Cextcall(lbl, _ty_res, _ty_args, _alloc) ->
Printf.sprintf "extcall \"%s\"%s" lbl (location d)
| Cload (c, Asttypes.Immutable) -> Printf.sprintf "load %s" (chunk c)
| Cload (c, Asttypes.Mutable) -> Printf.sprintf "load_mut %s" (chunk c)
| Cconst_int (n, _dbg) -> fprintf ppf "%i" n
| Cconst_natint (n, _dbg) ->
fprintf ppf "%s" (Nativeint.to_string n)
- | Cblockheader(n, d) ->
- fprintf ppf "block-hdr(%s)%s"
- (Nativeint.to_string n) (location d)
| Cconst_float (n, _dbg) -> fprintf ppf "%F" n
| Cconst_symbol (s, _dbg) -> fprintf ppf "\"%s\"" s
- | Cconst_pointer (n, _dbg) -> fprintf ppf "%ia" n
- | Cconst_natpointer (n, _dbg) -> fprintf ppf "%sa" (Nativeint.to_string n)
| Cvar id -> V.print ppf id
| Clet(id, def, (Clet(_, _, _) as body)) ->
let print_binding id ppf def =
List.iter (fun e -> fprintf ppf "@ %a" expr e) el;
begin match op with
| Capply mty -> fprintf ppf "@ %a" machtype mty
- | Cextcall(_, mty, _, _) -> fprintf ppf "@ %a" machtype mty
+ | Cextcall(_, ty_res, ty_args, _) ->
+ fprintf ppf "@ %a" extcall_signature (ty_res, ty_args)
| _ -> ()
end;
fprintf ppf ")@]"
val rec_flag : formatter -> Cmm.rec_flag -> unit
val machtype_component : formatter -> Cmm.machtype_component -> unit
-val machtype : formatter -> Cmm.machtype_component array -> unit
+val machtype : formatter -> Cmm.machtype -> unit
+val exttype : formatter -> Cmm.exttype -> unit
+val extcall_signature : formatter -> Cmm.machtype * Cmm.exttype list -> unit
val integer_comparison : Cmm.integer_comparison -> string
val float_comparison : Cmm.float_comparison -> string
val chunk : Cmm.memory_chunk -> string
fprintf ppf "prologue"
| Lop op ->
begin match op with
- | Ialloc _ | Icall_ind _ | Icall_imm _ | Iextcall _ ->
+ | Ialloc _ | Icall_ind | Icall_imm _ | Iextcall _ ->
fprintf ppf "@[<1>{%a}@]@," regsetaddr i.live
| _ -> ()
end;
| Ilsr -> " >>u "
| Iasr -> " >>s "
| Icomp cmp -> intcomp cmp
- | Icheckbound { label_after_error; spacetime_index; } ->
- if not Config.spacetime then " check > "
- else
- Printf.sprintf "check[lbl=%s,index=%d] > "
- begin
- match label_after_error with
- | None -> ""
- | Some lbl -> Int.to_string lbl
- end
- spacetime_index
+ | Icheckbound -> Printf.sprintf "check > "
let test tst ppf arg =
match tst with
| Iconst_int n -> fprintf ppf "%s" (Nativeint.to_string n)
| Iconst_float f -> fprintf ppf "%F" (Int64.float_of_bits f)
| Iconst_symbol s -> fprintf ppf "\"%s\"" s
- | Icall_ind _ -> fprintf ppf "call %a" regs arg
- | Icall_imm { func; _ } -> fprintf ppf "call \"%s\" %a" func regs arg
- | Itailcall_ind _ -> fprintf ppf "tailcall %a" regs arg
+ | Icall_ind -> fprintf ppf "call %a" regs arg
+ | Icall_imm { func; } -> fprintf ppf "call \"%s\" %a" func regs arg
+ | Itailcall_ind -> fprintf ppf "tailcall %a" regs arg
| Itailcall_imm { func; } -> fprintf ppf "tailcall \"%s\" %a" func regs arg
| Iextcall { func; alloc; _ } ->
fprintf ppf "extcall \"%s\" %a%s" func regs arg
(Array.sub arg 1 (Array.length arg - 1))
reg arg.(0)
(if is_assign then "(assign)" else "(init)")
- | Ialloc { bytes = n; _ } ->
+ | Ialloc { bytes = n; } ->
fprintf ppf "alloc %i" n;
- if Config.spacetime then begin
- fprintf ppf "(spacetime node = %a)" reg arg.(0)
- end
| Iintop(op) -> fprintf ppf "%a%s%a" reg arg.(0) (intop op) reg arg.(1)
| Iintop_imm(op, n) -> fprintf ppf "%a%s%i" reg arg.(0) (intop op) n
| Inegf -> fprintf ppf "-f %a" reg arg.(0)
val rotate_registers: bool
(* Calling conventions *)
-val loc_arguments: Reg.t array -> Reg.t array * int
-val loc_results: Reg.t array -> Reg.t array
-val loc_parameters: Reg.t array -> Reg.t array
+val loc_arguments: Cmm.machtype -> Reg.t array * int
+val loc_results: Cmm.machtype -> Reg.t array
+val loc_parameters: Cmm.machtype -> Reg.t array
(* For argument number [n] split across multiple registers, the target-specific
implementation of [loc_external_arguments] must return [regs] such that
- [regs.(n).(0)] is to hold the part of the value at the lowest address.
- (All that matters for the input to [loc_external_arguments] is the pattern
- of lengths and register types of the various supplied arrays.) *)
-val loc_external_arguments: Reg.t array array -> Reg.t array array * int
-val loc_external_results: Reg.t array -> Reg.t array
+ [regs.(n).(0)] is to hold the part of the value at the lowest address. *)
+val loc_external_arguments: Cmm.exttype list -> Reg.t array array * int
+val loc_external_results: Cmm.machtype -> Reg.t array
val loc_exn_bucket: Reg.t
-val loc_spacetime_node_hole: Reg.t
(* The maximum number of arguments of an OCaml to OCaml function call for
which it is guaranteed there will be no arguments passed on the stack.
incr currstamp;
r
+let typv rv =
+ Array.map (fun r -> r.typ) rv
+
let anonymous t =
match Raw_name.to_string t.raw_name with
| None -> true
val createv_like: t array -> t array
val clone: t -> t
val at_location: Cmm.machtype_component -> location -> t
-
+val typv: t array -> Cmm.machtype
val anonymous : t -> bool
(* Name for printing *)
However, something needs to be done for the function pointer in
indirect calls. *)
Iend | Ireturn | Iop(Itailcall_imm _) | Iraise _ -> i
- | Iop(Itailcall_ind _) ->
+ | Iop(Itailcall_ind) ->
let newarg = self#makereg1 i.arg in
insert_moves i.arg newarg
{i with arg = newarg}
| Iop(Icall_imm _ | Iextcall _) ->
{i with next = self#reload i.next}
- | Iop(Icall_ind _) ->
+ | Iop(Icall_ind) ->
let newarg = self#makereg1 i.arg in
insert_moves i.arg newarg
{i with arg = newarg; next = self#reload i.next}
let new_body = self#reload f.fun_body in
({fun_name = f.fun_name; fun_args = f.fun_args;
fun_body = new_body; fun_codegen_options = f.fun_codegen_options;
- fun_dbg = f.fun_dbg; fun_spacetime_shape = f.fun_spacetime_shape;
+ fun_dbg = f.fun_dbg;
fun_contains_calls = f.fun_contains_calls;
fun_num_stack_slots = Array.copy num_stack_slots;
},
| Imultaddf of bool (* multiply, optionally negate, and add *)
| Imultsubf of bool (* multiply, optionally negate, and subtract *)
-let spacetime_node_hole_pointer_is_live_before = function
- | Imultaddf _ | Imultsubf _ -> false
-
(* Addressing modes *)
type addressing_mode =
(* Record live pointers at call points *)
-let record_frame_label ?label live dbg =
- let lbl =
- match label with
- | None -> new_label()
- | Some label -> label
- in
+let record_frame_label live dbg =
+ let lbl = new_label () in
let live_offset = ref [] in
Reg.Set.iter
(function
~live_offset:!live_offset dbg;
lbl
-let record_frame ?label live dbg =
- let lbl = record_frame_label ?label live dbg in
+let record_frame live dbg =
+ let lbl = record_frame_label live dbg in
`{emit_label lbl}:\n`
(* Record calls to the GC -- we've moved them out of the way *)
let bound_error_sites = ref ([] : bound_error_call list)
-let bound_error_label ?label dbg =
+let bound_error_label dbg =
if !Clflags.debug || !bound_error_sites = [] then begin
let lbl_bound_error = new_label() in
- let lbl_frame = record_frame_label ?label Reg.Set.empty (Dbg_other dbg) in
+ let lbl_frame = record_frame_label Reg.Set.empty (Dbg_other dbg) in
bound_error_sites :=
{ bd_lbl = lbl_bound_error;
bd_frame_lbl = lbl_frame } :: !bound_error_sites;
` fld {emit_reg i.res.(0)}, {emit_label lbl}, {emit_reg reg_tmp}\n`
| Lop(Iconst_symbol s) ->
` la {emit_reg i.res.(0)}, {emit_symbol s}\n`
- | Lop(Icall_ind {label_after = label}) ->
+ | Lop(Icall_ind) ->
` jalr {emit_reg i.arg.(0)}\n`;
- record_frame ~label i.live (Dbg_other i.dbg)
- | Lop(Icall_imm {func; label_after = label}) ->
+ record_frame i.live (Dbg_other i.dbg)
+ | Lop(Icall_imm {func}) ->
` {emit_call func}\n`;
- record_frame ~label i.live (Dbg_other i.dbg)
- | Lop(Itailcall_ind {label_after = _}) ->
+ record_frame i.live (Dbg_other i.dbg)
+ | Lop(Itailcall_ind) ->
let n = frame_size() in
if !contains_calls then reload_ra n;
emit_stack_adjustment n;
` jr {emit_reg i.arg.(0)}\n`
- | Lop(Itailcall_imm {func; label_after = _}) ->
+ | Lop(Itailcall_imm {func}) ->
if func = !function_name then begin
` j {emit_label !tailrec_entry_point}\n`
end else begin
emit_stack_adjustment n;
` {emit_tail func}\n`
end
- | Lop(Iextcall{func; alloc = true; label_after = label}) ->
+ | Lop(Iextcall{func; alloc = true}) ->
` la {emit_reg reg_t2}, {emit_symbol func}\n`;
` {emit_call "caml_c_call"}\n`;
- record_frame ~label i.live (Dbg_other i.dbg)
- | Lop(Iextcall{func; alloc = false; label_after = _}) ->
+ record_frame i.live (Dbg_other i.dbg)
+ | Lop(Iextcall{func; alloc = false}) ->
` {emit_call func}\n`
| Lop(Istackoffset n) ->
assert (n mod 16 = 0);
| Double | Double_u -> "fsd"
in
` {emit_string instr} {emit_reg i.arg.(0)}, {emit_int ofs}({emit_reg i.arg.(1)})\n`
- | Lop(Ialloc {bytes; label_after_call_gc = label; dbginfo}) ->
- let lbl_frame_lbl = record_frame_label ?label i.live (Dbg_alloc dbginfo) in
+ | Lop(Ialloc {bytes; dbginfo}) ->
+ let lbl_frame_lbl = record_frame_label i.live (Dbg_alloc dbginfo) in
let lbl_after_alloc = new_label () in
let lbl_call_gc = new_label () in
let n = -bytes in
` sltu {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`;
` xori {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`;
end
- | Lop(Iintop (Icheckbound {label_after_error = label; _})) ->
- let lbl = bound_error_label ?label i.dbg in
+ | Lop(Iintop (Icheckbound)) ->
+ let lbl = bound_error_label i.dbg in
` bleu {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_label lbl}\n`
| Lop(Iintop op) ->
let instr = name_for_intop op in
` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
| Lop(Iintop_imm(Isub, n)) ->
` addi {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_int(-n)}\n`
- | Lop(Iintop_imm(Icomp _, _)) ->
- Misc.fatal_error "Emit.emit_instr (Iintop_imm (Icomp _, _))"
- | Lop(Iintop_imm(Icheckbound {label_after_error = label; _}, n)) ->
- let lbl = bound_error_label ?label i.dbg in
- ` li {emit_reg reg_tmp}, {emit_int n}\n`;
- ` bleu {emit_reg i.arg.(0)}, {emit_reg reg_tmp}, {emit_label lbl}\n`
| Lop(Iintop_imm(op, n)) ->
let instr = name_for_intop_imm op in
` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_int n}\n`
a0-a7 0-7 arguments/results
s2-s9 8-15 arguments/results (preserved by C)
t2-t6 16-20 temporary
- t0-t1 21-22 temporary (used by code generator)
+ t0 21 temporary
+ t1 22 temporary (used by code generator)
s0 23 domain pointer (preserved by C)
s1 24 trap pointer (preserved by C)
s10 25 allocation pointer (preserved by C)
Additional notes
----------------
- - t0-t1 are used by the assembler and code generator, so
- not available for register allocation.
+ - t1 is used by the code generator, so not available for register
+ allocation.
- t0-t6 may be used by PLT stubs, so should not be used to pass
arguments and may be clobbered by [Ialloc] in the presence of dynamic
let float = ref first_float in
let ofs = ref 0 in
for i = 0 to Array.length arg - 1 do
- match arg.(i).typ with
+ match arg.(i) with
| Val | Int | Addr as ty ->
if !int <= last_int then begin
loc.(i) <- phys_reg !int;
let max_arguments_for_tailcalls = 16
-let loc_spacetime_node_hole = Reg.dummy (* Spacetime unsupported *)
-
(* OCaml calling convention:
first integer args in a0 .. a7, s2 .. s9
first float args in fa0 .. fa7, fs2 .. fs9
remaining args on stack.
Return values in a0 .. a7, s2 .. s9 or fa0 .. fa7, fs2 .. fs9. *)
-let single_regs arg = Array.map (fun arg -> [| arg |]) arg
-let ensure_single_regs res =
- Array.map (function
- | [| res |] -> res
- | _ -> failwith "proc.ensure_single_regs"
- ) res
-
let loc_arguments arg =
calling_conventions 0 15 110 125 outgoing arg
let ofs = ref 0 in
for i = 0 to Array.length arg - 1 do
match arg.(i) with
- | [| arg |] ->
- begin match arg.typ with
- | Val | Int | Addr as ty ->
- if !int <= last_int then begin
- loc.(i) <- [| phys_reg !int |];
- incr int
- end else begin
- loc.(i) <- [| stack_slot (make_stack !ofs) ty |];
- ofs := !ofs + size_int
- end
- | Float ->
- if !float <= last_float then begin
- loc.(i) <- [| phys_reg !float |];
- incr float
- end else if !int <= last_int then begin
- loc.(i) <- [| phys_reg !int |];
- incr int
- end else begin
- loc.(i) <- [| stack_slot (make_stack !ofs) Float |];
- ofs := !ofs + size_float
- end
+ | Val | Int | Addr as ty ->
+ if !int <= last_int then begin
+ loc.(i) <- [| phys_reg !int |];
+ incr int
+ end else begin
+ loc.(i) <- [| stack_slot (make_stack !ofs) ty |];
+ ofs := !ofs + size_int
+ end
+ | Float ->
+ if !float <= last_float then begin
+ loc.(i) <- [| phys_reg !float |];
+ incr float
+ end else if !int <= last_int then begin
+ loc.(i) <- [| phys_reg !int |];
+ incr int
+ end else begin
+ loc.(i) <- [| stack_slot (make_stack !ofs) Float |];
+ ofs := !ofs + size_float
end
- | _ ->
- fatal_error "Proc.calling_conventions: bad number of register for \
- multi-register argument"
done;
(loc, Misc.align !ofs 16) (* Keep stack 16-aligned. *)
-let loc_external_arguments arg =
+let loc_external_arguments ty_args =
+ let arg = Cmm.machtype_of_exttype_list ty_args in
external_calling_conventions 0 7 110 117 outgoing arg
let loc_external_results res =
- let (loc, _ofs) =
- external_calling_conventions 0 1 110 111 not_supported (single_regs res)
- in
- ensure_single_regs loc
+ let (loc, _ofs) = calling_conventions 0 1 110 111 not_supported res
+ in loc
(* Exceptions are in a0 *)
else [| |]
let destroyed_at_oper = function
- | Iop(Icall_ind _ | Icall_imm _ | Iextcall{alloc = true; _}) -> all_phys_regs
+ | Iop(Icall_ind | Icall_imm _ | Iextcall{alloc = true; _}) -> all_phys_regs
| Iop(Iextcall{alloc = false; _}) -> destroyed_at_c_call
| Iop(Ialloc _) -> destroyed_at_alloc
| Iop(Istore(Single, _, _)) -> [| phys_reg 100 |]
registers). *)
let op_is_pure = function
- | Icall_ind _ | Icall_imm _ | Itailcall_ind _ | Itailcall_imm _
+ | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
| Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
- | Iintop(Icheckbound _) | Iintop_imm(Icheckbound _, _) -> false
+ | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _) -> false
| Ispecific(Imultaddf _ | Imultsubf _) -> true
| _ -> true
(* Instruction selection *)
-class selector = object (self)
+class selector = object
inherit Selectgen.selector_generic as super
-method is_immediate n = is_immediate n
+(* RISC-V does not support immediate operands for comparison operators *)
+method is_immediate_test _cmp _n = false
+
+method! is_immediate op n =
+ match op with
+ | Iadd | Iand | Ior | Ixor -> is_immediate n
+ (* sub immediate is turned into add immediate opposite *)
+ | Isub -> is_immediate (-n)
+ | _ -> super#is_immediate op n
method select_addressing _ = function
- | Cop(Cadda, [arg; Cconst_int (n, _)], _) when self#is_immediate n ->
+ | Cop(Cadda, [arg; Cconst_int (n, _)], _) when is_immediate n ->
(Iindexed n, arg)
| Cop(Cadda, [arg1; Cop(Caddi, [arg2; Cconst_int (n, _)], _)], dbg)
- when self#is_immediate n ->
+ when is_immediate n ->
(Iindexed n, Cop(Caddi, [arg1; arg2], dbg))
| arg ->
(Iindexed 0, arg)
(Ispecific (Imultsubf true), [arg1; arg2; arg3])
| (Cnegf, [Cop(Caddf, [Cop(Cmulf, [arg1; arg2], _); arg3], _)]) ->
(Ispecific (Imultaddf true), [arg1; arg2; arg3])
- (* RISC-V does not support immediate operands for comparison operators *)
- | (Ccmpi comp, args) -> (Iintop(Icomp (Isigned comp)), args)
- | (Ccmpa comp, args) -> (Iintop(Icomp (Iunsigned comp)), args)
- (* RISC-V does not support immediate operands for multiply/multiply high *)
- | (Cmuli, _) -> (Iintop Imul, args)
- | (Cmulhi, _) -> (Iintop Imulh, args)
| _ ->
super#select_operation op args dbg
-(* Instruction selection for conditionals *)
-
-method! select_condition = function
- Cop(Ccmpi cmp, args, _) ->
- (Iinttest(Isigned cmp), Ctuple args)
- | Cop(Ccmpa cmp, args, _) ->
- (Iinttest(Iunsigned cmp), Ctuple args)
- | Cop(Ccmpf cmp, args, _) ->
- (Ifloattest cmp, Ctuple args)
- | Cop(Cand, [arg; Cconst_int (1, _)], _) ->
- (Ioddtest, arg)
- | arg ->
- (Itruetest, arg)
end
let fundecl f = (new selector)#emit_fundecl f
Imultaddf (* multiply and add *)
| Imultsubf (* multiply and subtract *)
-let spacetime_node_hole_pointer_is_live_before _specific_op = false
-
(* Addressing modes *)
type addressing_mode =
(* Record live pointers at call points *)
-let record_frame_label ?label live dbg =
- let lbl =
- match label with
- | None -> new_label()
- | Some label -> label
- in
+let record_frame_label live dbg =
+ let lbl = new_label() in
let live_offset = ref [] in
Reg.Set.iter
(function
~live_offset:!live_offset dbg;
lbl
-let record_frame ?label live dbg =
- let lbl = record_frame_label ?label live dbg in
+let record_frame live dbg =
+ let lbl = record_frame_label live dbg in
`{emit_label lbl}:`
(* Record calls to caml_call_gc, emitted out of line. *)
let bound_error_sites = ref ([] : bound_error_call list)
let bound_error_call = ref 0
-let bound_error_label ?label dbg =
+let bound_error_label dbg =
if !Clflags.debug then begin
let lbl_bound_error = new_label() in
- let lbl_frame = record_frame_label ?label Reg.Set.empty (Dbg_other dbg) in
+ let lbl_frame = record_frame_label Reg.Set.empty (Dbg_other dbg) in
bound_error_sites :=
{ bd_lbl = lbl_bound_error; bd_frame = lbl_frame } :: !bound_error_sites;
lbl_bound_error
` ld {emit_reg i.res.(0)}, 0(%r1)\n`
| Lop(Iconst_symbol s) ->
emit_load_symbol_addr i.res.(0) s
- | Lop(Icall_ind { label_after; }) ->
+ | Lop(Icall_ind) ->
` basr %r14, {emit_reg i.arg.(0)}\n`;
- `{record_frame i.live (Dbg_other i.dbg) ~label:label_after}\n`
+ `{record_frame i.live (Dbg_other i.dbg)}\n`
- | Lop(Icall_imm { func; label_after; }) ->
+ | Lop(Icall_imm { func; }) ->
emit_call func;
- `{record_frame i.live (Dbg_other i.dbg) ~label:label_after}\n`
- | Lop(Itailcall_ind { label_after = _; }) ->
+ `{record_frame i.live (Dbg_other i.dbg)}\n`
+ | Lop(Itailcall_ind) ->
let n = frame_size() in
if !contains_calls then
` lg %r14, {emit_int(n - size_addr)}(%r15)\n`;
emit_stack_adjust (-n);
` br {emit_reg i.arg.(0)}\n`
- | Lop(Itailcall_imm { func; label_after = _; }) ->
+ | Lop(Itailcall_imm { func; }) ->
if func = !function_name then
` brcl 15, {emit_label !tailrec_entry_point}\n`
else begin
` brcl 15, {emit_symbol func}\n`
end
- | Lop(Iextcall { func; alloc; label_after; }) ->
+ | Lop(Iextcall { func; alloc; }) ->
if not alloc then emit_call func
else begin
emit_load_symbol_addr reg_r7 func;
emit_call "caml_c_call";
- `{record_frame i.live (Dbg_other i.dbg) ~label:label_after}\n`
+ `{record_frame i.live (Dbg_other i.dbg)}\n`
end
| Lop(Istackoffset n) ->
| Double | Double_u -> "stdy" in
emit_load_store storeinstr addr i.arg 1 i.arg.(0)
- | Lop(Ialloc { bytes = n; label_after_call_gc; dbginfo }) ->
+ | Lop(Ialloc { bytes = n; dbginfo }) ->
let lbl_after_alloc = new_label() in
let lbl_call_gc = new_label() in
let lbl_frame =
- record_frame_label i.live (Dbg_alloc dbginfo) ?label:label_after_call_gc
+ record_frame_label i.live (Dbg_alloc dbginfo)
in
call_gc_sites :=
{ gc_lbl = lbl_call_gc;
` brc {emit_int mask}, {emit_label lbl}\n`;
` lghi {emit_reg i.res.(0)}, 0\n`;
`{emit_label lbl}:\n`
- | Lop(Iintop (Icheckbound { label_after_error; })) ->
- let lbl = bound_error_label i.dbg ?label:label_after_error in
+ | Lop(Iintop (Icheckbound)) ->
+ let lbl = bound_error_label i.dbg in
` clgr {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
` brcl 12, {emit_label lbl}\n` (* branch if unsigned le *)
| Lop(Iintop op) ->
` brc {emit_int mask}, {emit_label lbl}\n`;
` lghi {emit_reg i.res.(0)}, 0\n`;
`{emit_label lbl}:\n`
- | Lop(Iintop_imm(Icheckbound { label_after_error; }, n)) ->
- let lbl = bound_error_label i.dbg ?label:label_after_error in
+ | Lop(Iintop_imm(Icheckbound, n)) ->
+ let lbl = bound_error_label i.dbg in
if n >= 0 then begin
` clgfi {emit_reg i.arg.(0)}, {emit_int n}\n`;
` brcl 12, {emit_label lbl}\n` (* branch if unsigned le *)
let stack_slot slot ty =
Reg.at_location ty (Stack slot)
-let loc_spacetime_node_hole = Reg.dummy (* Spacetime unsupported *)
-
(* Calling conventions *)
let calling_conventions
let float = ref first_float in
let ofs = ref stack_ofs in
for i = 0 to Array.length arg - 1 do
- match arg.(i).typ with
+ match arg.(i) with
| Val | Int | Addr as ty ->
if !int <= last_int then begin
loc.(i) <- phys_reg !int;
Always reserve 160 bytes at bottom of stack, plus whatever is needed
to hold the overflow arguments. *)
-let loc_external_arguments arg =
- let arg =
- Array.map (fun regs -> assert (Array.length regs = 1); regs.(0)) arg in
- let (loc, ofs) =
- calling_conventions 0 4 100 103 outgoing 160 arg in
+let loc_external_arguments ty_args =
+ let arg = Cmm.machtype_of_exttype_list ty_args in
+ let (loc, ofs) = calling_conventions 0 4 100 103 outgoing 160 arg in
(Array.map (fun reg -> [|reg|]) loc, ofs)
(* Results are in GPR 2 and FPR 0 *)
100; 101; 102; 103; 104; 105; 106; 107])
let destroyed_at_oper = function
- Iop(Icall_ind _ | Icall_imm _ | Iextcall { alloc = true; _ }) ->
+ Iop(Icall_ind | Icall_imm _ | Iextcall { alloc = true; _ }) ->
all_phys_regs
| Iop(Iextcall { alloc = false; _ }) -> destroyed_at_c_call
| _ -> [||]
registers). *)
let op_is_pure = function
- | Icall_ind _ | Icall_imm _ | Itailcall_ind _ | Itailcall_imm _
+ | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
| Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
- | Iintop(Icheckbound _) | Iintop_imm(Icheckbound _, _) -> false
+ | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _) -> false
| Ispecific(Imultaddf | Imultsubf) -> true
| _ -> true
(* Other instructions are regular *)
| _ -> raise Use_default
+let is_immediate n = n <= 0x7FFF_FFFF && n >= -0x8000_0000
+let is_immediate_logical n = n <= 0xFFFF_FFFF && n >= 0
+
class selector = object (self)
inherit Selectgen.selector_generic as super
-method is_immediate n = n <= 0x7FFF_FFFF && n >= (-1-0x7FFF_FFFF)
- (* -1-.... : hack so that this can be compiled on 32-bit
- (cf 'make check_all_arches') *)
+method is_immediate_test cmp n =
+ match cmp with
+ | Isigned _ -> is_immediate n
+ | Iunsigned _ -> is_immediate_logical n
+
+method! is_immediate op n =
+ match op with
+ | Iadd | Imul -> is_immediate n
+ | Isub -> is_immediate (-n)
+ | Iand -> n <= -1 && n >= -0x1_0000_0000
+ | Ior | Ixor -> is_immediate_logical n
+ | Icomp c -> self#is_immediate_test c n
+ | Icheckbound -> is_immediate_logical n (* unsigned comparison *)
+ | _ -> super#is_immediate op n
method select_addressing _chunk exp =
let (a, d) = select_addr exp in
method! select_operation op args dbg =
match (op, args) with
- (* Z does not support immediate operands for multiply high *)
- (Cmulhi, _) -> (Iintop Imulh, args)
- (* The and, or and xor instructions have a different range of immediate
- operands than the other instructions *)
- | (Cand, _) ->
- self#select_logical Iand (-1 lsl 32 (*0x1_0000_0000*)) (-1) args
- | (Cor, _) -> self#select_logical Ior 0 (1 lsl 32 - 1 (*0xFFFF_FFFF*)) args
- | (Cxor, _) -> self#select_logical Ixor 0 (1 lsl 32 - 1 (*0xFFFF_FFFF*)) args
(* Recognize mult-add and mult-sub instructions *)
| (Caddf, [Cop(Cmulf, [arg1; arg2], _); arg3]) ->
(Ispecific Imultaddf, [arg1; arg2; arg3])
| _ ->
super#select_operation op args dbg
-method select_logical op lo hi = function
- [arg; Cconst_int (n, _)] when n >= lo && n <= hi ->
- (Iintop_imm(op, n), [arg])
- | [Cconst_int (n, _); arg] when n >= lo && n <= hi ->
- (Iintop_imm(op, n), [arg])
- | args ->
- (Iintop op, args)
-
-
method! insert_op_debug env op dbg rs rd =
try
let (rsrc, rdst) = pseudoregs_for_operation op rs rd in
that terminate a basic block. *)
method oper_in_basic_block = function
- Icall_ind _ -> false
+ Icall_ind -> false
| Icall_imm _ -> false
- | Itailcall_ind _ -> false
+ | Itailcall_ind -> false
| Itailcall_imm _ -> false
| Iextcall _ -> false
| Istackoffset _ -> false
| _ -> false
method is_checkbound = function
- Iintop (Icheckbound _) -> true
- | Iintop_imm(Icheckbound _, _) -> true
+ Iintop(Icheckbound) -> true
+ | Iintop_imm(Icheckbound, _) -> true
| _ -> false
method private instr_is_store instr =
else begin
let critical_outputs =
match i.desc with
- Lop(Icall_ind _ | Itailcall_ind _) -> [| i.arg.(0) |]
+ Lop(Icall_ind | Itailcall_ind) -> [| i.arg.(0) |]
| Lop(Icall_imm _ | Itailcall_imm _ | Iextcall _) -> [||]
| Lreturn -> [||]
| _ -> i.arg in
fun_body = new_body;
fun_fast = f.fun_fast;
fun_dbg = f.fun_dbg;
- fun_spacetime_shape = f.fun_spacetime_shape;
fun_tailrec_entry_point_label = f.fun_tailrec_entry_point_label;
fun_contains_calls = f.fun_contains_calls;
fun_num_stack_slots = f.fun_num_stack_slots;
let oper_result_type = function
Capply ty -> ty
- | Cextcall(_s, ty, _alloc, _) -> ty
+ | Cextcall(_s, ty_res, _ty_args, _alloc) -> ty_res
| Cload (c, _) ->
begin match c with
| Word_val -> typ_val
let size_expr (env:environment) exp =
let rec size localenv = function
Cconst_int _ | Cconst_natint _ -> Arch.size_int
- | Cconst_symbol _ | Cconst_pointer _ | Cconst_natpointer _ ->
+ | Cconst_symbol _ ->
Arch.size_addr
| Cconst_float _ -> Arch.size_float
- | Cblockheader _ -> Arch.size_int
| Cvar id ->
begin try
V.Map.find id localenv
| Cconst_natint _ -> true
| Cconst_float _ -> true
| Cconst_symbol _ -> true
- | Cconst_pointer _ -> true
- | Cconst_natpointer _ -> true
- | Cblockheader _ -> true
| Cvar _ -> true
| Ctuple el -> List.for_all self#is_simple_expr el
| Clet(_id, arg, body) | Clet_mut(_id, _, arg, body) ->
let module EC = Effect_and_coeffect in
match exp with
| Cconst_int _ | Cconst_natint _ | Cconst_float _ | Cconst_symbol _
- | Cconst_pointer _ | Cconst_natpointer _ | Cblockheader _
| Cvar _ -> EC.none
| Ctuple el -> EC.join_list_map el self#effects_of
| Clet (_id, arg, body) | Clet_mut (_id, _, arg, body) ->
| Cassign _ | Cswitch _ | Ccatch _ | Cexit _ | Ctrywith _ ->
EC.arbitrary
-(* Says whether an integer constant is a suitable immediate argument *)
+(* Says whether an integer constant is a suitable immediate argument for
+ the given integer operation *)
-method virtual is_immediate : int -> bool
+method is_immediate op n =
+ match op with
+ | Ilsl | Ilsr | Iasr -> n >= 0 && n < Arch.size_int * 8
+ | _ -> false
+
+(* Says whether an integer constant is a suitable immediate argument for
+ the given integer test *)
+
+method virtual is_immediate_test : integer_comparison -> int -> bool
(* Selection of addressing modes *)
method mark_c_tailcall = ()
method mark_instr = function
- | Iop (Icall_ind _ | Icall_imm _ | Iextcall _) ->
+ | Iop (Icall_ind | Icall_imm _ | Iextcall _) ->
self#mark_call
- | Iop (Itailcall_ind _ | Itailcall_imm _) ->
+ | Iop (Itailcall_ind | Itailcall_imm _) ->
self#mark_tailcall
| Iop (Ialloc _) ->
self#mark_call (* caml_alloc*, caml_garbage_collection *)
- | Iop (Iintop (Icheckbound _) | Iintop_imm(Icheckbound _, _)) ->
+ | Iop (Iintop(Icheckbound) | Iintop_imm(Icheckbound, _)) ->
self#mark_c_tailcall (* caml_ml_array_bound_error *)
| Iraise raise_kind ->
begin match raise_kind with
(* Default instruction selection for operators *)
-method select_allocation bytes =
- Ialloc { bytes; label_after_call_gc = None;
- dbginfo = []; spacetime_index = 0; }
-method select_allocation_args _env = [| |]
-
-method select_checkbound () =
- Icheckbound { spacetime_index = 0; label_after_error = None; }
-method select_checkbound_extra_args () = []
-
method select_operation op args _dbg =
match (op, args) with
| (Capply _, Cconst_symbol (func, _dbg) :: rem) ->
- let label_after = Cmm.new_label () in
- (Icall_imm { func; label_after; }, rem)
+ (Icall_imm { func; }, rem)
| (Capply _, _) ->
- let label_after = Cmm.new_label () in
- (Icall_ind { label_after; }, args)
- | (Cextcall(func, _ty, alloc, label_after), _) ->
- let label_after =
- match label_after with
- | None -> Cmm.new_label ()
- | Some label_after -> label_after
- in
- Iextcall { func; alloc; label_after; }, args
+ (Icall_ind, args)
+ | (Cextcall(func, ty_res, ty_args, alloc), _) ->
+ Iextcall { func; ty_res; ty_args; alloc; }, args
| (Cload (chunk, _mut), [arg]) ->
let (addr, eloc) = self#select_addressing chunk arg in
(Iload(chunk, addr), [eloc])
(Istore(chunk, addr, is_assign), [arg2; eloc])
(* Inversion addr/datum in Istore *)
end
- | (Calloc, _) -> (self#select_allocation 0), args
+ | (Calloc, _) -> (Ialloc {bytes = 0; dbginfo = []}), args
| (Caddi, _) -> self#select_arith_comm Iadd args
| (Csubi, _) -> self#select_arith Isub args
| (Cmuli, _) -> self#select_arith_comm Imul args
| (Cand, _) -> self#select_arith_comm Iand args
| (Cor, _) -> self#select_arith_comm Ior args
| (Cxor, _) -> self#select_arith_comm Ixor args
- | (Clsl, _) -> self#select_shift Ilsl args
- | (Clsr, _) -> self#select_shift Ilsr args
- | (Casr, _) -> self#select_shift Iasr args
+ | (Clsl, _) -> self#select_arith Ilsl args
+ | (Clsr, _) -> self#select_arith Ilsr args
+ | (Casr, _) -> self#select_arith Iasr args
| (Ccmpi comp, _) -> self#select_arith_comp (Isigned comp) args
| (Caddv, _) -> self#select_arith_comm Iadd args
| (Cadda, _) -> self#select_arith_comm Iadd args
| (Cfloatofint, _) -> (Ifloatofint, args)
| (Cintoffloat, _) -> (Iintoffloat, args)
| (Ccheckbound, _) ->
- let extra_args = self#select_checkbound_extra_args () in
- let op = self#select_checkbound () in
- self#select_arith op (args @ extra_args)
+ self#select_arith Icheckbound args
| _ -> Misc.fatal_error "Selection.select_oper"
method private select_arith_comm op = function
- [arg; Cconst_int (n, _)] when self#is_immediate n ->
- (Iintop_imm(op, n), [arg])
- | [arg; Cconst_pointer (n, _)] when self#is_immediate n ->
+ | [arg; Cconst_int (n, _)] when self#is_immediate op n ->
(Iintop_imm(op, n), [arg])
- | [Cconst_int (n, _); arg] when self#is_immediate n ->
- (Iintop_imm(op, n), [arg])
- | [Cconst_pointer (n, _); arg] when self#is_immediate n ->
+ | [Cconst_int (n, _); arg] when self#is_immediate op n ->
(Iintop_imm(op, n), [arg])
| args ->
(Iintop op, args)
method private select_arith op = function
- [arg; Cconst_int (n, _)] when self#is_immediate n ->
- (Iintop_imm(op, n), [arg])
- | [arg; Cconst_pointer (n, _)] when self#is_immediate n ->
- (Iintop_imm(op, n), [arg])
- | args ->
- (Iintop op, args)
-
-method private select_shift op = function
- [arg; Cconst_int (n, _)] when n >= 0 && n < Arch.size_int * 8 ->
+ | [arg; Cconst_int (n, _)] when self#is_immediate op n ->
(Iintop_imm(op, n), [arg])
| args ->
(Iintop op, args)
method private select_arith_comp cmp = function
- [arg; Cconst_int (n, _)] when self#is_immediate n ->
+ | [arg; Cconst_int (n, _)] when self#is_immediate (Icomp cmp) n ->
(Iintop_imm(Icomp cmp, n), [arg])
- | [arg; Cconst_pointer (n, _)] when self#is_immediate n ->
- (Iintop_imm(Icomp cmp, n), [arg])
- | [Cconst_int (n, _); arg] when self#is_immediate n ->
- (Iintop_imm(Icomp(swap_intcomp cmp), n), [arg])
- | [Cconst_pointer (n, _); arg] when self#is_immediate n ->
+ | [Cconst_int (n, _); arg]
+ when self#is_immediate (Icomp(swap_intcomp cmp)) n ->
(Iintop_imm(Icomp(swap_intcomp cmp), n), [arg])
| args ->
(Iintop(Icomp cmp), args)
(* Instruction selection for conditionals *)
method select_condition = function
- Cop(Ccmpi cmp, [arg1; Cconst_int (n, _)], _) when self#is_immediate n ->
- (Iinttest_imm(Isigned cmp, n), arg1)
- | Cop(Ccmpi cmp, [Cconst_int (n, _); arg2], _) when self#is_immediate n ->
- (Iinttest_imm(Isigned(swap_integer_comparison cmp), n), arg2)
- | Cop(Ccmpi cmp, [arg1; Cconst_pointer (n, _)], _) when self#is_immediate n ->
+ | Cop(Ccmpi cmp, [arg1; Cconst_int (n, _)], _)
+ when self#is_immediate_test (Isigned cmp) n ->
(Iinttest_imm(Isigned cmp, n), arg1)
- | Cop(Ccmpi cmp, [Cconst_pointer (n, _); arg2], _) when self#is_immediate n ->
+ | Cop(Ccmpi cmp, [Cconst_int (n, _); arg2], _)
+ when self#is_immediate_test (Isigned (swap_integer_comparison cmp)) n ->
(Iinttest_imm(Isigned(swap_integer_comparison cmp), n), arg2)
| Cop(Ccmpi cmp, args, _) ->
(Iinttest(Isigned cmp), Ctuple args)
- | Cop(Ccmpa cmp, [arg1; Cconst_pointer (n, _)], _) when self#is_immediate n ->
- (Iinttest_imm(Iunsigned cmp, n), arg1)
- | Cop(Ccmpa cmp, [arg1; Cconst_int (n, _)], _) when self#is_immediate n ->
+ | Cop(Ccmpa cmp, [arg1; Cconst_int (n, _)], _)
+ when self#is_immediate_test (Iunsigned cmp) n ->
(Iinttest_imm(Iunsigned cmp, n), arg1)
- | Cop(Ccmpa cmp, [Cconst_pointer (n, _); arg2], _) when self#is_immediate n ->
- (Iinttest_imm(Iunsigned(swap_integer_comparison cmp), n), arg2)
- | Cop(Ccmpa cmp, [Cconst_int (n, _); arg2], _) when self#is_immediate n ->
+ | Cop(Ccmpa cmp, [Cconst_int (n, _); arg2], _)
+ when self#is_immediate_test (Iunsigned (swap_integer_comparison cmp)) n ->
(Iinttest_imm(Iunsigned(swap_integer_comparison cmp), n), arg2)
| Cop(Ccmpa cmp, args, _) ->
(Iinttest(Iunsigned cmp), Ctuple args)
method insert _env desc arg res =
instr_seq <- instr_cons desc arg res instr_seq
-method extract_core ~end_instr =
+method extract =
let rec extract res i =
if i == dummy_instr
then res
else extract {i with next = res} i.next in
- extract end_instr instr_seq
-
-method extract =
- self#extract_core ~end_instr:(end_instr ())
+ extract (end_instr ()) instr_seq
(* Insert a sequence of moves from one pseudoreg set to another. *)
method insert_op env op rs rd =
self#insert_op_debug env op Debuginfo.none rs rd
-method emit_blockheader env n _dbg =
- let r = self#regs_for typ_int in
- Some(self#insert_op env (Iconst_int n) [||] r)
-
-method about_to_emit_call _env _insn _arg _dbg = None
-
-(* Prior to a function call, update the Spacetime node hole pointer hard
- register. *)
-
-method private maybe_emit_spacetime_move env ~spacetime_reg =
- Option.iter (fun reg ->
- self#insert_moves env reg [| Proc.loc_spacetime_node_hole |])
- spacetime_reg
-
(* Add the instructions for the given expression
at the end of the self sequence *)
adding this register to the frame table would be redundant *)
let r = self#regs_for typ_int in
Some(self#insert_op env (Iconst_symbol n) [||] r)
- | Cconst_pointer (n, _dbg) ->
- let r = self#regs_for typ_int in
- Some(self#insert_op env (Iconst_int(Nativeint.of_int n)) [||] r)
- | Cconst_natpointer (n, _dbg) ->
- let r = self#regs_for typ_int in
- Some(self#insert_op env (Iconst_int n) [||] r)
- | Cblockheader(n, dbg) ->
- self#emit_blockheader env n dbg
| Cvar v ->
begin try
Some(env_find v env)
let ty = oper_result_type op in
let (new_op, new_args) = self#select_operation op simple_args dbg in
match new_op with
- Icall_ind _ ->
+ Icall_ind ->
let r1 = self#emit_tuple env new_args in
let rarg = Array.sub r1 1 (Array.length r1 - 1) in
let rd = self#regs_for ty in
- let (loc_arg, stack_ofs) = Proc.loc_arguments rarg in
- let loc_res = Proc.loc_results rd in
- let spacetime_reg =
- self#about_to_emit_call env (Iop new_op) [| r1.(0) |] dbg
- in
+ let (loc_arg, stack_ofs) = Proc.loc_arguments (Reg.typv rarg) in
+ let loc_res = Proc.loc_results (Reg.typv rd) in
self#insert_move_args env rarg loc_arg stack_ofs;
- self#maybe_emit_spacetime_move env ~spacetime_reg;
self#insert_debug env (Iop new_op) dbg
(Array.append [|r1.(0)|] loc_arg) loc_res;
self#insert_move_results env loc_res rd stack_ofs;
| Icall_imm _ ->
let r1 = self#emit_tuple env new_args in
let rd = self#regs_for ty in
- let (loc_arg, stack_ofs) = Proc.loc_arguments r1 in
- let loc_res = Proc.loc_results rd in
- let spacetime_reg =
- self#about_to_emit_call env (Iop new_op) [| |] dbg
- in
+ let (loc_arg, stack_ofs) = Proc.loc_arguments (Reg.typv r1) in
+ let loc_res = Proc.loc_results (Reg.typv rd) in
self#insert_move_args env r1 loc_arg stack_ofs;
- self#maybe_emit_spacetime_move env ~spacetime_reg;
self#insert_debug env (Iop new_op) dbg loc_arg loc_res;
self#insert_move_results env loc_res rd stack_ofs;
Some rd
- | Iextcall _ ->
- let spacetime_reg =
- self#about_to_emit_call env (Iop new_op) [| |] dbg
- in
- let (loc_arg, stack_ofs) = self#emit_extcall_args env new_args in
- self#maybe_emit_spacetime_move env ~spacetime_reg;
+ | Iextcall { ty_args; _} ->
+ let (loc_arg, stack_ofs) =
+ self#emit_extcall_args env ty_args new_args in
let rd = self#regs_for ty in
let loc_res =
self#insert_op_debug env new_op dbg
- loc_arg (Proc.loc_external_results rd) in
+ loc_arg (Proc.loc_external_results (Reg.typv rd)) in
self#insert_move_results env loc_res rd stack_ofs;
Some rd
- | Ialloc { bytes = _; spacetime_index; label_after_call_gc; } ->
+ | Ialloc { bytes = _; } ->
let rd = self#regs_for typ_val in
let bytes = size_expr env (Ctuple new_args) in
assert (bytes mod Arch.size_addr = 0);
let alloc_words = bytes / Arch.size_addr in
let op =
- Ialloc { bytes; spacetime_index; label_after_call_gc;
- dbginfo = [{alloc_words; alloc_dbg = dbg}] }
+ Ialloc { bytes; dbginfo = [{alloc_words; alloc_dbg = dbg}] }
in
- let args = self#select_allocation_args env in
- self#insert_debug env (Iop op) dbg args rd;
+ self#insert_debug env (Iop op) dbg [||] rd;
self#emit_stores env new_args rd;
Some rd
| op ->
method private emit_tuple env exp_list =
Array.concat (self#emit_tuple_not_flattened env exp_list)
-method emit_extcall_args env args =
+method emit_extcall_args env ty_args args =
let args = self#emit_tuple_not_flattened env args in
- let arg_hard_regs, stack_ofs =
- Proc.loc_external_arguments (Array.of_list args)
- in
- (* Flattening [args] and [arg_hard_regs] causes parts of values split
- across multiple registers to line up correctly, by virtue of the
- semantics of [split_int64_for_32bit_target] in cmmgen.ml, and the
- required semantics of [loc_external_arguments] (see proc.mli). *)
- let args = Array.concat args in
- let arg_hard_regs = Array.concat (Array.to_list arg_hard_regs) in
- self#insert_move_args env args arg_hard_regs stack_ofs;
- arg_hard_regs, stack_ofs
+ let ty_args =
+ if ty_args = [] then List.map (fun _ -> XInt) args else ty_args in
+ let locs, stack_ofs = Proc.loc_external_arguments ty_args in
+ let ty_args = Array.of_list ty_args in
+ if stack_ofs <> 0 then
+ self#insert env (Iop(Istackoffset stack_ofs)) [||] [||];
+ List.iteri
+ (fun i arg ->
+ self#insert_move_extcall_arg env ty_args.(i) arg locs.(i))
+ args;
+ Array.concat (Array.to_list locs), stack_ofs
+
+method insert_move_extcall_arg env _ty_arg src dst =
+ (* The default implementation is one or two ordinary moves.
+ (Two in the case of an int64 argument on a 32-bit platform.)
+ It can be overridden to use special move instructions,
+ for example a "32-bit move" instruction for int32 arguments. *)
+ self#insert_moves env src dst
method emit_stores env data regs_addr =
let a =
match self#emit_expr env exp with
None -> ()
| Some r ->
- let loc = Proc.loc_results r in
+ let loc = Proc.loc_results (Reg.typv r) in
self#insert_moves env r loc;
self#insert env Ireturn loc [||]
| Some(simple_args, env) ->
let (new_op, new_args) = self#select_operation op simple_args dbg in
match new_op with
- Icall_ind { label_after; } ->
+ Icall_ind ->
let r1 = self#emit_tuple env new_args in
let rarg = Array.sub r1 1 (Array.length r1 - 1) in
- let (loc_arg, stack_ofs) = Proc.loc_arguments rarg in
+ let (loc_arg, stack_ofs) = Proc.loc_arguments (Reg.typv rarg) in
if stack_ofs = 0 then begin
- let call = Iop (Itailcall_ind { label_after; }) in
- let spacetime_reg =
- self#about_to_emit_call env call [| r1.(0) |] dbg
- in
+ let call = Iop (Itailcall_ind) in
self#insert_moves env rarg loc_arg;
- self#maybe_emit_spacetime_move env ~spacetime_reg;
self#insert_debug env call dbg
(Array.append [|r1.(0)|] loc_arg) [||];
end else begin
let rd = self#regs_for ty in
- let loc_res = Proc.loc_results rd in
- let spacetime_reg =
- self#about_to_emit_call env (Iop new_op) [| r1.(0) |] dbg
- in
+ let loc_res = Proc.loc_results (Reg.typv rd) in
self#insert_move_args env rarg loc_arg stack_ofs;
- self#maybe_emit_spacetime_move env ~spacetime_reg;
self#insert_debug env (Iop new_op) dbg
(Array.append [|r1.(0)|] loc_arg) loc_res;
self#insert env (Iop(Istackoffset(-stack_ofs))) [||] [||];
self#insert env Ireturn loc_res [||]
end
- | Icall_imm { func; label_after; } ->
+ | Icall_imm { func; } ->
let r1 = self#emit_tuple env new_args in
- let (loc_arg, stack_ofs) = Proc.loc_arguments r1 in
+ let (loc_arg, stack_ofs) = Proc.loc_arguments (Reg.typv r1) in
if stack_ofs = 0 then begin
- let call = Iop (Itailcall_imm { func; label_after; }) in
- let spacetime_reg =
- self#about_to_emit_call env call [| |] dbg
- in
+ let call = Iop (Itailcall_imm { func; }) in
self#insert_moves env r1 loc_arg;
- self#maybe_emit_spacetime_move env ~spacetime_reg;
self#insert_debug env call dbg loc_arg [||];
end else if func = !current_function_name then begin
- let call = Iop (Itailcall_imm { func; label_after; }) in
- let loc_arg' = Proc.loc_parameters r1 in
- let spacetime_reg =
- self#about_to_emit_call env call [| |] dbg
- in
+ let call = Iop (Itailcall_imm { func; }) in
+ let loc_arg' = Proc.loc_parameters (Reg.typv r1) in
self#insert_moves env r1 loc_arg';
- self#maybe_emit_spacetime_move env ~spacetime_reg;
self#insert_debug env call dbg loc_arg' [||];
end else begin
let rd = self#regs_for ty in
- let loc_res = Proc.loc_results rd in
- let spacetime_reg =
- self#about_to_emit_call env (Iop new_op) [| |] dbg
- in
+ let loc_res = Proc.loc_results (Reg.typv rd) in
self#insert_move_args env r1 loc_arg stack_ofs;
- self#maybe_emit_spacetime_move env ~spacetime_reg;
self#insert_debug env (Iop new_op) dbg loc_arg loc_res;
self#insert env (Iop(Istackoffset(-stack_ofs))) [||] [||];
self#insert env Ireturn loc_res [||]
begin match opt_r1 with
None -> ()
| Some r1 ->
- let loc = Proc.loc_results r1 in
+ let loc = Proc.loc_results (Reg.typv r1) in
self#insert_moves env r1 loc;
self#insert env Ireturn loc [||]
end
| Cop _
| Cconst_int _ | Cconst_natint _ | Cconst_float _ | Cconst_symbol _
- | Cconst_pointer _ | Cconst_natpointer _ | Cblockheader _
| Cvar _
| Cassign _
| Ctuple _
s#emit_tail env exp;
s#extract
-(* Insertion of the function prologue *)
-
-method insert_prologue _f ~loc_arg ~rarg ~spacetime_node_hole:_ ~env =
- self#insert_moves env loc_arg rarg;
- None
-
(* Sequentialization of a function definition *)
-method initial_env () = env_empty
-
method emit_fundecl f =
current_function_name := f.Cmm.fun_name;
let rargs =
(fun (id, ty) -> let r = self#regs_for ty in name_regs id r; r)
f.Cmm.fun_args in
let rarg = Array.concat rargs in
- let loc_arg = Proc.loc_parameters rarg in
- (* To make it easier to add the Spacetime instrumentation code, we
- first emit the body and extract the resulting instruction sequence;
- then we emit the prologue followed by any Spacetime instrumentation. The
- sequence resulting from extracting the latter (prologue + instrumentation)
- together is then simply prepended to the body. *)
+ let loc_arg = Proc.loc_parameters (Reg.typv rarg) in
let env =
List.fold_right2
(fun (id, _ty) r env -> env_add id r env)
- f.Cmm.fun_args rargs (self#initial_env ()) in
- let spacetime_node_hole, env =
- if not Config.spacetime then None, env
- else begin
- let reg = self#regs_for typ_int in
- let node_hole = V.create_local "spacetime_node_hole" in
- Some (node_hole, reg), env_add (VP.create node_hole) reg env
- end
- in
+ f.Cmm.fun_args rargs env_empty in
+ self#insert_moves env loc_arg rarg;
self#emit_tail env f.Cmm.fun_body;
let body = self#extract in
- instr_seq <- dummy_instr;
- let fun_spacetime_shape =
- self#insert_prologue f ~loc_arg ~rarg ~spacetime_node_hole ~env
- in
- let body = self#extract_core ~end_instr:body in
instr_iter (fun instr -> self#mark_instr instr.Mach.desc) body;
{ fun_name = f.Cmm.fun_name;
fun_args = loc_arg;
fun_body = body;
fun_codegen_options = f.Cmm.fun_codegen_options;
fun_dbg = f.Cmm.fun_dbg;
- fun_spacetime_shape;
fun_num_stack_slots = Array.make Proc.num_register_classes 0;
fun_contains_calls = !contains_calls;
}
end
-(* Tail call criterion (estimated). Assumes:
-- all arguments are of type "int" (always the case for OCaml function calls)
-- one extra argument representing the closure environment (conservative).
-*)
-
-let is_tail_call nargs =
- assert (Reg.dummy.typ = Int);
- let args = Array.make (nargs + 1) Reg.dummy in
- let (_loc_arg, stack_ofs) = Proc.loc_arguments args in
- stack_ofs = 0
-
-let _ =
- Simplif.is_tail_native_heuristic := is_tail_call
-
let reset () =
current_function_name := ""
class virtual selector_generic : object
(* The following methods must or can be overridden by the processor
description *)
- method virtual is_immediate : int -> bool
+ method is_immediate : Mach.integer_operation -> int -> bool
+ (* Must be overriden to indicate whether a constant is a suitable
+ immediate operand to the given integer arithmetic instruction.
+ The default implementation handles shifts by immediate amounts,
+ but produces no immediate operations otherwise. *)
+ method virtual is_immediate_test : Mach.integer_comparison -> int -> bool
(* Must be defined to indicate whether a constant is a suitable
- immediate operand to arithmetic instructions *)
+ immediate operand to the given integer test *)
method virtual select_addressing :
Cmm.memory_chunk -> Cmm.expression -> Arch.addressing_mode * Cmm.expression
(* Must be defined to select addressing modes *)
-> Reg.t array -> Reg.t array
(* Can be overridden to deal with 2-address instructions
or instructions with hardwired input/output registers *)
+ method insert_move_extcall_arg :
+ environment -> Cmm.exttype -> Reg.t array -> Reg.t array -> unit
+ (* Can be overridden to deal with unusual unboxed calling conventions,
+ e.g. on a 64-bit platform, passing unboxed 32-bit arguments
+ in 32-bit stack slots. *)
method emit_extcall_args :
- environment -> Cmm.expression list -> Reg.t array * int
+ environment -> Cmm.exttype list -> Cmm.expression list -> Reg.t array * int
(* Can be overridden to deal with stack-based calling conventions *)
method emit_stores :
environment -> Cmm.expression list -> Reg.t array -> unit
above; overloading this is useful if Ispecific instructions need
marking *)
- (* The following method is the entry point and should not be overridden
- (except by [Spacetime_profiling]). *)
+ (* The following method is the entry point and should not be overridden. *)
method emit_fundecl : Cmm.fundecl -> Mach.fundecl
(* The following methods should not be overridden. They cannot be
declared "private" in the current implementation because they
are not always applied to "self", but ideally they should be private. *)
method extract : Mach.instruction
- method extract_core : end_instr:Mach.instruction -> Mach.instruction
method insert :
environment -> Mach.instruction_desc -> Reg.t array -> Reg.t array -> unit
method insert_debug :
environment -> Cmm.expression -> Reg.t array option
method emit_tail : environment -> Cmm.expression -> unit
- (* Only for the use of [Spacetime_profiling]. *)
- method select_allocation : int -> Mach.operation
- method select_allocation_args : environment -> Reg.t array
- method select_checkbound : unit -> Mach.integer_operation
- method select_checkbound_extra_args : unit -> Cmm.expression list
- method emit_blockheader
- : environment
- -> nativeint
- -> Debuginfo.t
- -> Reg.t array option
- method about_to_emit_call
- : environment
- -> Mach.instruction_desc
- -> Reg.t array
- -> Debuginfo.t
- -> Reg.t array option
- method initial_env : unit -> environment
- method insert_prologue
- : Cmm.fundecl
- -> loc_arg:Reg.t array
- -> rarg:Reg.t array
- -> spacetime_node_hole:(Backend_var.t * Reg.t array) option
- -> env:environment
- -> Mach.spacetime_shape option
-
- val mutable instr_seq : Mach.instruction
-
(* [contains_calls] is declared as a reference instance variable,
instead of a mutable boolean instance variable,
because the traversal uses functional object copies. *)
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Mark Shinwell and Leo White, Jane Street Europe *)
-(* *)
-(* Copyright 2015--2018 Jane Street Group LLC *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-[@@@ocaml.warning "+a-4-30-40-41-42"]
-
-module V = Backend_var
-module VP = Backend_var.With_provenance
-
-let node_num_header_words = 2 (* [Node_num_header_words] in the runtime. *)
-let index_within_node = ref node_num_header_words
-(* The [lazy]s are to ensure that we don't create [V.t]s at toplevel
- when not using Spacetime profiling. (This could cause stamps to differ
- between bytecode and native .cmis when no .mli is present, e.g.
- arch.ml.) *)
-let spacetime_node = ref (lazy (Cmm.Cvar (V.create_local "dummy")))
-let spacetime_node_ident = ref (lazy (V.create_local "dummy"))
-let current_function_label = ref None
-let direct_tail_call_point_indexes = ref []
-
-let reverse_shape = ref ([] : Mach.spacetime_shape)
-
-(* CR-someday mshinwell: This code could be updated to use [placeholder_dbg] as
- in [Cmmgen]. *)
-let cconst_int i = Cmm.Cconst_int (i, Debuginfo.none)
-let cconst_natint i = Cmm.Cconst_natint (i, Debuginfo.none)
-let cconst_symbol s = Cmm.Cconst_symbol (s, Debuginfo.none)
-
-let something_was_instrumented () =
- !index_within_node > node_num_header_words
-
-let next_index_within_node ~part_of_shape ~label =
- let index = !index_within_node in
- begin match part_of_shape with
- | Mach.Direct_call_point _ ->
- incr index_within_node;
- if Config.enable_call_counts then begin
- incr index_within_node
- end
- | Mach.Indirect_call_point ->
- incr index_within_node
- | Mach.Allocation_point ->
- incr index_within_node;
- incr index_within_node;
- incr index_within_node
- end;
- reverse_shape := (part_of_shape, label) :: !reverse_shape;
- index
-
-let reset ~spacetime_node_ident:ident ~function_label =
- index_within_node := node_num_header_words;
- spacetime_node := lazy (Cmm.Cvar ident);
- spacetime_node_ident := lazy ident;
- direct_tail_call_point_indexes := [];
- current_function_label := Some function_label;
- reverse_shape := []
-
-let code_for_function_prologue ~function_name ~fun_dbg:dbg ~node_hole =
- let node = V.create_local "node" in
- let new_node = V.create_local "new_node" in
- let must_allocate_node = V.create_local "must_allocate_node" in
- let is_new_node = V.create_local "is_new_node" in
- let no_tail_calls = List.length !direct_tail_call_point_indexes < 1 in
- let open Cmm in
- let initialize_direct_tail_call_points_and_return_node =
- let new_node_encoded = V.create_local "new_node_encoded" in
- (* The callee node pointers within direct tail call points must initially
- point back at the start of the current node and be marked as per
- [Encode_tail_caller_node] in the runtime. *)
- let indexes = !direct_tail_call_point_indexes in
- let body =
- List.fold_left (fun init_code index ->
- (* Cf. [Direct_callee_node] in the runtime. *)
- let offset_in_bytes = index * Arch.size_addr in
- Csequence (
- Cop (Cstore (Word_int, Lambda.Assignment),
- [Cop (Caddi, [Cvar new_node; cconst_int offset_in_bytes], dbg);
- Cvar new_node_encoded], dbg),
- init_code))
- (Cvar new_node)
- indexes
- in
- match indexes with
- | [] -> body
- | _ ->
- Clet (VP.create new_node_encoded,
- (* Cf. [Encode_tail_caller_node] in the runtime. *)
- Cop (Cor, [Cvar new_node; cconst_int 1], dbg),
- body)
- in
- let pc = V.create_local "pc" in
- Clet (VP.create node,
- Cop (Cload (Word_int, Asttypes.Mutable), [Cvar node_hole], dbg),
- Clet (VP.create must_allocate_node,
- Cop (Cand, [Cvar node; cconst_int 1], dbg),
- Cifthenelse (
- Cop (Ccmpi Cne, [Cvar must_allocate_node; cconst_int 1], dbg),
- dbg,
- Cvar node,
- dbg,
- Clet (VP.create is_new_node,
- Clet (VP.create pc, cconst_symbol function_name,
- Cop (Cextcall ("caml_spacetime_allocate_node",
- [| Int |], false, None),
- [cconst_int (1 (* header *) + !index_within_node);
- Cvar pc;
- Cvar node_hole;
- ],
- dbg)),
- Clet (VP.create new_node,
- Cop (Cload (Word_int, Asttypes.Mutable), [Cvar node_hole], dbg),
- if no_tail_calls then Cvar new_node
- else
- Cifthenelse (
- Cop (Ccmpi Ceq, [Cvar is_new_node; cconst_int 0], dbg),
- dbg,
- Cvar new_node,
- dbg,
- initialize_direct_tail_call_points_and_return_node,
- dbg))),
- dbg)))
-
-let code_for_blockheader ~value's_header ~node ~dbg =
- let num_words = Nativeint.shift_right_logical value's_header 10 in
- let existing_profinfo = V.create_local "existing_profinfo" in
- let existing_count = V.create_local "existing_count" in
- let profinfo = V.create_local "profinfo" in
- let address_of_profinfo = V.create_local "address_of_profinfo" in
- let label = Cmm.new_label () in
- let index_within_node =
- next_index_within_node ~part_of_shape:Mach.Allocation_point ~label
- in
- let offset_into_node = Arch.size_addr * index_within_node in
- let open Cmm in
- let generate_new_profinfo =
- (* This will generate a static branch to a function that should usually
- be in the cache, which hopefully gives a good code size/performance
- balance.
- The "Some label" is important: it provides the link between the shape
- table, the allocation point, and the frame descriptor table---enabling
- the latter table to be used for resolving a program counter at such
- a point to a location.
- *)
- Cop (Cextcall ("caml_spacetime_generate_profinfo", [| Int |],
- false, Some label),
- [Cvar address_of_profinfo;
- cconst_int (index_within_node + 1)],
- dbg)
- in
- (* Check if we have already allocated a profinfo value for this allocation
- point with the current backtrace. If so, use that value; if not,
- allocate a new one. *)
- Clet (VP.create address_of_profinfo,
- Cop (Caddi, [
- Cvar node;
- cconst_int offset_into_node;
- ], dbg),
- Clet (VP.create existing_profinfo,
- Cop (Cload (Word_int, Asttypes.Mutable), [Cvar address_of_profinfo],
- dbg),
- Clet (VP.create profinfo,
- Cifthenelse (
- Cop (Ccmpi Cne, [Cvar existing_profinfo; cconst_int 1 (* () *)], dbg),
- dbg,
- Cvar existing_profinfo,
- dbg,
- generate_new_profinfo,
- dbg),
- Clet (VP.create existing_count,
- Cop (Cload (Word_int, Asttypes.Mutable), [
- Cop (Caddi,
- [Cvar address_of_profinfo; cconst_int Arch.size_addr], dbg)
- ], dbg),
- Csequence (
- Cop (Cstore (Word_int, Lambda.Assignment),
- [Cop (Caddi,
- [Cvar address_of_profinfo; cconst_int Arch.size_addr], dbg);
- Cop (Caddi, [
- Cvar existing_count;
- (* N.B. "*2" since the count is an OCaml integer.
- The "1 +" is to count the value's header. *)
- cconst_int (2 * (1 + Nativeint.to_int num_words));
- ], dbg);
- ], dbg),
- (* [profinfo] looks like a black [Infix_tag] header. Instead of
- having to mask [profinfo] before ORing it with the desired
- header, we can use an XOR trick, to keep code size down. *)
- let value's_header =
- Nativeint.logxor value's_header
- (Nativeint.logor
- ((Nativeint.logor (Nativeint.of_int Obj.infix_tag)
- (Nativeint.shift_left 3n (* <- Caml_black *) 8)))
- (Nativeint.shift_left
- (* The following is the [Infix_offset_val], in words. *)
- (Nativeint.of_int (index_within_node + 1)) 10))
- in
- Cop (Cxor, [Cvar profinfo; cconst_natint value's_header], dbg))))))
-
-type callee =
- | Direct of string
- | Indirect of Cmm.expression
-
-let code_for_call ~node ~callee ~is_tail ~label dbg =
- (* We treat self recursive calls as tail calls to avoid blow-ups in the
- graph. *)
- let is_self_recursive_call =
- match callee with
- | Direct callee ->
- begin match !current_function_label with
- | None -> Misc.fatal_error "[current_function_label] not set"
- | Some label -> String.equal callee label
- end
- | Indirect _ -> false
- in
- let is_tail = is_tail || is_self_recursive_call in
- let index_within_node =
- match callee with
- | Direct callee ->
- next_index_within_node
- ~part_of_shape:(Mach.Direct_call_point { callee; })
- ~label
- | Indirect _ ->
- next_index_within_node ~part_of_shape:Mach.Indirect_call_point ~label
- in
- begin match callee with
- (* If this is a direct tail call point, we need to note down its index,
- so the correct initialization code can be emitted in the prologue. *)
- | Direct _ when is_tail ->
- direct_tail_call_point_indexes :=
- index_within_node::!direct_tail_call_point_indexes
- | Direct _ | Indirect _ -> ()
- end;
- let place_within_node = V.create_local "place_within_node" in
- let open Cmm in
- Clet (VP.create place_within_node,
- Cop (Caddi, [node; cconst_int (index_within_node * Arch.size_addr)], dbg),
- (* The following code returns the address that is to be moved into the
- (hard) node hole pointer register immediately before the call.
- (That move is inserted in [Selectgen].) *)
- match callee with
- | Direct _callee ->
- if Config.enable_call_counts then begin
- let count_addr = V.create_local "call_count_addr" in
- let count = V.create_local "call_count" in
- Clet (VP.create count_addr,
- Cop (Caddi, [Cvar place_within_node; cconst_int Arch.size_addr], dbg),
- Clet (VP.create count,
- Cop (Cload (Word_int, Asttypes.Mutable), [Cvar count_addr], dbg),
- Csequence (
- Cop (Cstore (Word_int, Lambda.Assignment),
- (* Adding 2 really means adding 1; the count is encoded
- as an OCaml integer. *)
- [Cvar count_addr; Cop (Caddi, [Cvar count; cconst_int 2], dbg)],
- dbg),
- Cvar place_within_node)))
- end else begin
- Cvar place_within_node
- end
- | Indirect callee ->
- let caller_node =
- if is_tail then node
- else cconst_int 1 (* [Val_unit] *)
- in
- Cop (Cextcall ("caml_spacetime_indirect_node_hole_ptr",
- [| Int |], false, None),
- [callee; Cvar place_within_node; caller_node],
- dbg))
-
-class virtual instruction_selection = object (self)
- inherit Selectgen.selector_generic as super
-
- (* [disable_instrumentation] ensures that we don't try to instrument the
- instrumentation... *)
- val mutable disable_instrumentation = false
-
- method private instrument_direct_call ~env ~func ~is_tail ~label_after dbg =
- let instrumentation =
- code_for_call
- ~node:(Lazy.force !spacetime_node)
- ~callee:(Direct func)
- ~is_tail
- ~label:label_after
- dbg
- in
- match self#emit_expr env instrumentation with
- | None -> assert false
- | Some reg -> Some reg
-
- method private instrument_indirect_call ~env ~callee ~is_tail
- ~label_after dbg =
- (* [callee] is a pseudoregister, so we have to bind it in the environment
- and reference the variable to which it is bound. *)
- let callee_ident = V.create_local "callee" in
- let env = Selectgen.env_add (VP.create callee_ident) [| callee |] env in
- let instrumentation =
- code_for_call
- ~node:(Lazy.force !spacetime_node)
- ~callee:(Indirect (Cmm.Cvar callee_ident))
- ~is_tail
- ~label:label_after
- dbg
- in
- match self#emit_expr env instrumentation with
- | None -> assert false
- | Some reg -> Some reg
-
- method private can_instrument () =
- Config.spacetime && not disable_instrumentation
-
- method! about_to_emit_call env desc arg dbg =
- if not (self#can_instrument ()) then None
- else
- let module M = Mach in
- match desc with
- | M.Iop (M.Icall_imm { func; label_after; }) ->
- assert (Array.length arg = 0);
- self#instrument_direct_call ~env ~func ~is_tail:false ~label_after dbg
- | M.Iop (M.Icall_ind { label_after; }) ->
- assert (Array.length arg = 1);
- self#instrument_indirect_call ~env ~callee:arg.(0)
- ~is_tail:false ~label_after dbg
- | M.Iop (M.Itailcall_imm { func; label_after; }) ->
- assert (Array.length arg = 0);
- self#instrument_direct_call ~env ~func ~is_tail:true ~label_after dbg
- | M.Iop (M.Itailcall_ind { label_after; }) ->
- assert (Array.length arg = 1);
- self#instrument_indirect_call ~env ~callee:arg.(0)
- ~is_tail:true ~label_after dbg
- | M.Iop (M.Iextcall { func; alloc = true; label_after; }) ->
- (* N.B. No need to instrument "noalloc" external calls. *)
- assert (Array.length arg = 0);
- self#instrument_direct_call ~env ~func ~is_tail:false ~label_after dbg
- | _ -> None
-
- method private instrument_blockheader ~env ~value's_header ~dbg =
- let instrumentation =
- code_for_blockheader
- ~node:(Lazy.force !spacetime_node_ident)
- ~value's_header ~dbg
- in
- self#emit_expr env instrumentation
-
- method private emit_prologue f ~node_hole ~env =
- (* We don't need the prologue unless we inserted some instrumentation.
- This corresponds to adding the prologue if the function contains one
- or more call or allocation points. *)
- if something_was_instrumented () then begin
- let prologue_cmm =
- code_for_function_prologue ~function_name:f.Cmm.fun_name ~node_hole
- ~fun_dbg:f.Cmm.fun_dbg
- in
- disable_instrumentation <- true;
- let node_temp_reg =
- match self#emit_expr env prologue_cmm with
- | None ->
- Misc.fatal_error "Spacetime prologue instruction \
- selection did not yield a destination register"
- | Some node_temp_reg -> node_temp_reg
- in
- disable_instrumentation <- false;
- let node = Lazy.force !spacetime_node_ident in
- let node_reg = Selectgen.env_find node env in
- self#insert_moves env node_temp_reg node_reg
- end
-
- method! emit_blockheader env n dbg =
- if self#can_instrument () then begin
- disable_instrumentation <- true;
- let result = self#instrument_blockheader ~env ~value's_header:n ~dbg in
- disable_instrumentation <- false;
- result
- end else begin
- super#emit_blockheader env n dbg
- end
-
- method! select_allocation bytes =
- if self#can_instrument () then begin
- (* Leave space for a direct call point. We cannot easily insert any
- instrumentation code, so the fields are filled in instead by
- [caml_spacetime_caml_garbage_collection]. *)
- let label = Cmm.new_label () in
- let index =
- next_index_within_node
- ~part_of_shape:(Mach.Direct_call_point { callee = "caml_call_gc"; })
- ~label
- in
- Mach.Ialloc {
- bytes;
- dbginfo = [];
- label_after_call_gc = Some label;
- spacetime_index = index;
- }
- end else begin
- super#select_allocation bytes
- end
-
- method! select_allocation_args env =
- if self#can_instrument () then begin
- let regs = Selectgen.env_find (Lazy.force !spacetime_node_ident) env in
- match regs with
- | [| reg |] -> [| reg |]
- | _ -> failwith "Expected one register only for spacetime_node_ident"
- end else begin
- super#select_allocation_args env
- end
-
- method! select_checkbound () =
- (* This follows [select_allocation], above. *)
- if self#can_instrument () then begin
- let label = Cmm.new_label () in
- let index =
- next_index_within_node
- ~part_of_shape:(
- Mach.Direct_call_point { callee = "caml_ml_array_bound_error"; })
- ~label
- in
- Mach.Icheckbound {
- label_after_error = Some label;
- spacetime_index = index;
- }
- end else begin
- super#select_checkbound ()
- end
-
- method! select_checkbound_extra_args () =
- if self#can_instrument () then begin
- (* This follows [select_allocation_args], above. *)
- [Cmm.Cvar (Lazy.force !spacetime_node_ident)]
- end else begin
- super#select_checkbound_extra_args ()
- end
-
- method! initial_env () =
- let env = super#initial_env () in
- if Config.spacetime then
- Selectgen.env_add (VP.create (Lazy.force !spacetime_node_ident))
- (self#regs_for Cmm.typ_int) env
- else
- env
-
- method! emit_fundecl f =
- if Config.spacetime then begin
- disable_instrumentation <- false;
- let node = V.create_local "spacetime_node" in
- reset ~spacetime_node_ident:node ~function_label:f.Cmm.fun_name
- end;
- super#emit_fundecl f
-
- method! insert_prologue f ~loc_arg ~rarg ~spacetime_node_hole ~env =
- let fun_spacetime_shape =
- super#insert_prologue f ~loc_arg ~rarg ~spacetime_node_hole ~env
- in
- (* CR-soon mshinwell: add check to make sure the node size doesn't exceed
- the chunk size of the allocator *)
- if not Config.spacetime then fun_spacetime_shape
- else begin
- let node_hole, node_hole_reg =
- match spacetime_node_hole with
- | None -> assert false
- | Some (node_hole, reg) -> node_hole, reg
- in
- self#insert_moves env [| Proc.loc_spacetime_node_hole |] node_hole_reg;
- self#emit_prologue f ~node_hole ~env;
- match !reverse_shape with
- | [] -> None
- (* N.B. We do not reverse the shape list, since the function that
- reconstructs it (caml_spacetime_shape_table) reverses it again. *)
- | reverse_shape -> Some reverse_shape
- end
-end
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Mark Shinwell and Leo White, Jane Street Europe *)
-(* *)
-(* Copyright 2015--2016 Jane Street Group LLC *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-(** Insertion of instrumentation code for Spacetime profiling. *)
-
-class virtual instruction_selection : Selectgen.selector_generic
match i.desc with
Iend ->
(i, before)
- | Ireturn | Iop(Itailcall_ind _) | Iop(Itailcall_imm _) ->
+ | Ireturn | Iop(Itailcall_ind) | Iop(Itailcall_imm _) ->
(add_reloads (Reg.inter_set_array before i.arg) i,
Reg.Set.empty)
- | Iop(Icall_ind _ | Icall_imm _ | Iextcall { alloc = true; }) ->
+ | Iop(Icall_ind | Icall_imm _ | Iextcall { alloc = true; }) ->
(* All regs live across must be spilled *)
let (new_next, finally) = reload i.next i.live in
(add_reloads (Reg.inter_set_array before i.arg)
match i.desc with
Iend ->
(i, finally)
- | Ireturn | Iop(Itailcall_ind _) | Iop(Itailcall_imm _) ->
+ | Ireturn | Iop(Itailcall_ind) | Iop(Itailcall_imm _) ->
(i, Reg.Set.empty)
| Iop Ireload ->
let (new_next, after) = spill i.next finally in
let before1 = Reg.diff_set_array after i.res in
let before =
match i.desc with
- Iop Icall_ind _ | Iop(Icall_imm _) | Iop(Iextcall _) | Iop(Ialloc _)
- | Iop(Iintop (Icheckbound _)) | Iop(Iintop_imm((Icheckbound _), _)) ->
+ Iop(Icall_ind) | Iop(Icall_imm _) | Iop(Iextcall _) | Iop(Ialloc _)
+ | Iop(Iintop (Icheckbound)) | Iop(Iintop_imm(Icheckbound, _)) ->
Reg.Set.union before1 !spill_at_raise
| _ ->
before1 in
fun_body = new_body;
fun_codegen_options = f.fun_codegen_options;
fun_dbg = f.fun_dbg;
- fun_spacetime_shape = f.fun_spacetime_shape;
fun_num_stack_slots = f.fun_num_stack_slots;
fun_contains_calls = f.fun_contains_calls;
}
match i.desc with
Iend ->
(i, sub)
- | Ireturn | Iop(Itailcall_ind _) | Iop(Itailcall_imm _) ->
+ | Ireturn | Iop(Itailcall_ind) | Iop(Itailcall_imm _) ->
(instr_cons_debug i.desc (subst_regs i.arg sub) [||] i.dbg i.next,
None)
| Iop Ireload when i.res.(0).loc = Unknown ->
fun_body = new_body;
fun_codegen_options = f.fun_codegen_options;
fun_dbg = f.fun_dbg;
- fun_spacetime_shape = f.fun_spacetime_shape;
fun_num_stack_slots = f.fun_num_stack_slots;
fun_contains_calls = f.fun_contains_calls;
}
let mk_cmp_gen cmp_op id nat ifso ifnot =
let dbg = Debuginfo.none in
let test =
- Cop (Ccmpi cmp_op, [ Cvar id; Cconst_natpointer (nat, dbg) ], dbg)
+ Cop (Ccmpi cmp_op, [ Cvar id; Cconst_natint (nat, dbg) ], dbg)
in
Cifthenelse (test, dbg, ifso, dbg, ifnot, dbg)
| VAL
| UNDERSCORE
| UIDENT of (
-# 697 "parsing/parser.mly"
+# 701 "parsing/parser.mly"
(string)
# 22 "parsing/parser.ml"
)
| THEN
| STRUCT
| STRING of (
-# 685 "parsing/parser.mly"
+# 689 "parsing/parser.mly"
(string * Location.t * string option)
# 34 "parsing/parser.ml"
)
| RBRACKET
| RBRACE
| QUOTED_STRING_ITEM of (
-# 689 "parsing/parser.mly"
+# 693 "parsing/parser.mly"
(string * Location.t * string * Location.t * string option)
# 47 "parsing/parser.ml"
)
| QUOTED_STRING_EXPR of (
-# 687 "parsing/parser.mly"
+# 691 "parsing/parser.mly"
(string * Location.t * string * Location.t * string option)
# 52 "parsing/parser.ml"
)
| QUESTION
| PRIVATE
| PREFIXOP of (
-# 671 "parsing/parser.mly"
+# 675 "parsing/parser.mly"
(string)
# 60 "parsing/parser.ml"
)
| PERCENT
| OR
| OPTLABEL of (
-# 664 "parsing/parser.mly"
+# 668 "parsing/parser.mly"
(string)
# 70 "parsing/parser.ml"
)
| MATCH
| LPAREN
| LIDENT of (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
# 88 "parsing/parser.ml"
)
| LETOP of (
-# 629 "parsing/parser.mly"
+# 633 "parsing/parser.mly"
(string)
# 93 "parsing/parser.ml"
)
| LBRACE
| LAZY
| LABEL of (
-# 634 "parsing/parser.mly"
+# 638 "parsing/parser.mly"
(string)
# 113 "parsing/parser.ml"
)
| INT of (
-# 633 "parsing/parser.mly"
+# 637 "parsing/parser.mly"
(string * char option)
# 118 "parsing/parser.ml"
)
| INITIALIZER
| INHERIT
| INFIXOP4 of (
-# 627 "parsing/parser.mly"
+# 631 "parsing/parser.mly"
(string)
# 125 "parsing/parser.ml"
)
| INFIXOP3 of (
-# 626 "parsing/parser.mly"
+# 630 "parsing/parser.mly"
(string)
# 130 "parsing/parser.ml"
)
| INFIXOP2 of (
-# 625 "parsing/parser.mly"
+# 629 "parsing/parser.mly"
(string)
# 135 "parsing/parser.ml"
)
| INFIXOP1 of (
-# 624 "parsing/parser.mly"
+# 628 "parsing/parser.mly"
(string)
# 140 "parsing/parser.ml"
)
| INFIXOP0 of (
-# 623 "parsing/parser.mly"
+# 627 "parsing/parser.mly"
(string)
# 145 "parsing/parser.ml"
)
| IN
| IF
| HASHOP of (
-# 682 "parsing/parser.mly"
+# 686 "parsing/parser.mly"
(string)
# 153 "parsing/parser.ml"
)
| FUN
| FOR
| FLOAT of (
-# 612 "parsing/parser.mly"
+# 616 "parsing/parser.mly"
(string * char option)
# 166 "parsing/parser.ml"
)
| ELSE
| DOWNTO
| DOTOP of (
-# 628 "parsing/parser.mly"
+# 632 "parsing/parser.mly"
(string)
# 180 "parsing/parser.ml"
)
| DOT
| DONE
| DOCSTRING of (
-# 705 "parsing/parser.mly"
+# 709 "parsing/parser.mly"
(Docstrings.docstring)
# 188 "parsing/parser.ml"
)
| DO
| CONSTRAINT
| COMMENT of (
-# 704 "parsing/parser.mly"
+# 708 "parsing/parser.mly"
(string * Location.t)
# 195 "parsing/parser.ml"
)
| COLON
| CLASS
| CHAR of (
-# 592 "parsing/parser.mly"
+# 596 "parsing/parser.mly"
(char)
# 206 "parsing/parser.ml"
)
| ASSERT
| AS
| ANDOP of (
-# 630 "parsing/parser.mly"
+# 634 "parsing/parser.mly"
(string)
# 219 "parsing/parser.ml"
)
Location.loc_ghost = true;
}
-let mktyp ~loc d = Typ.mk ~loc:(make_loc loc) d
+let mktyp ~loc ?attrs d = Typ.mk ~loc:(make_loc loc) ?attrs d
let mkpat ~loc d = Pat.mk ~loc:(make_loc loc) d
let mkexp ~loc d = Exp.mk ~loc:(make_loc loc) d
let mkmty ~loc ?attrs d = Mty.mk ~loc:(make_loc loc) ?attrs d
let mkpat_opt_constraint ~loc p = function
| None -> p
- | Some typ -> mkpat ~loc (Ppat_constraint(p, typ))
+ | Some typ -> ghpat ~loc (Ppat_constraint(p, typ))
let syntax_error () =
raise Syntaxerr.Escape_error
let lident x = Lident x
let ldot x y = Ldot(x,y)
let dotop_fun ~loc dotop =
- (* We could use ghexp here, but sticking to mkexp for parser.mly
- compatibility. TODO improve parser.mly *)
- mkexp ~loc (Pexp_ident (ghloc ~loc dotop))
+ ghexp ~loc (Pexp_ident (ghloc ~loc dotop))
let array_function ~loc str name =
ghloc ~loc (Ldot(Lident str,
else raise (Syntaxerr.Error(
Syntaxerr.Applicative_path (make_loc loc)))
-let exp_of_longident ~loc lid =
- mkexp ~loc (Pexp_ident {lid with txt = Lident(Longident.last lid.txt)})
-
(* [loc_map] could be [Location.map]. *)
let loc_map (f : 'a -> 'b) (x : 'a Location.loc) : 'b Location.loc =
{ x with txt = f x.txt }
+let make_ghost x = { x with loc = { x.loc with loc_ghost = true }}
+
let loc_last (id : Longident.t Location.loc) : string Location.loc =
loc_map Longident.last id
let loc_lident (id : string Location.loc) : Longident.t Location.loc =
loc_map (fun x -> Lident x) id
+let exp_of_longident ~loc lid =
+ let lid = make_ghost (loc_map (fun id -> Lident (Longident.last id)) lid) in
+ ghexp ~loc (Pexp_ident lid)
+
let exp_of_label ~loc lbl =
mkexp ~loc (Pexp_ident (loc_lident lbl))
-let pat_of_label ~loc lbl =
- mkpat ~loc (Ppat_var (loc_last lbl))
+let pat_of_label lbl =
+ Pat.mk ~loc:lbl.loc (Ppat_var (loc_last lbl))
let mk_newtypes ~loc newtypes exp =
let mkexp = mkexp ~loc in
let text_sig pos = Sig.text (rhs_text pos)
let text_cstr pos = Cf.text (rhs_text pos)
let text_csig pos = Ctf.text (rhs_text pos)
-let text_def pos = [Ptop_def (Str.text (rhs_text pos))]
+let text_def pos =
+ List.map (fun def -> Ptop_def [def]) (Str.text (rhs_text pos))
let extra_text startpos endpos text items =
match items with
let extra_cstr p1 p2 items = extra_text p1 p2 Cf.text items
let extra_csig p1 p2 items = extra_text p1 p2 Ctf.text items
let extra_def p1 p2 items =
- extra_text p1 p2 (fun txt -> [Ptop_def (Str.text txt)]) items
+ extra_text p1 p2
+ (fun txt -> List.map (fun def -> Ptop_def [def]) (Str.text txt))
+ items
let extra_rhs_core_type ct ~pos =
let docs = rhs_info pos in
err pmty.pmty_loc "only 'with type t =' constraints are supported"
in
match pmty with
- | {pmty_desc = Pmty_ident lid} -> (lid, [])
+ | {pmty_desc = Pmty_ident lid} -> (lid, [], pmty.pmty_attributes)
| {pmty_desc = Pmty_with({pmty_desc = Pmty_ident lid}, cstrs)} ->
- (lid, List.map map_cstr cstrs)
+ (lid, List.map map_cstr cstrs, pmty.pmty_attributes)
| _ ->
err pmty.pmty_loc
"only module type identifier and 'with type' constraints are supported"
}
-# 793 "parsing/parser.ml"
+# 797 "parsing/parser.ml"
module Tables = struct
Obj.repr ()
and default_reduction =
- (16, "\000\000\000\000\000\000\002\247\002\246\002\245\002\244\002\243\002\198\002\242\002\241\002\240\002\239\002\238\002\237\002\236\002\235\002\234\002\233\002\232\002\231\002\230\002\229\002\228\002\227\002\226\002\225\002\224\002\197\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\002\204\002\203\002\202\002\201\002\200\002\199\000\000\000\000\000*\000\186\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0035\001\168\001\147\001\165\001\164\001\163\001\169\001\173\000\000\0036\001\167\001\166\001\148\001\171\001\162\001\161\001\160\001\159\001\158\001\156\001\172\001\170\000\000\000\000\000\000\000\220\000\000\000\000\001\151\000\000\000\000\000\000\001\153\000\000\000\000\000\000\001\155\001\177\001\174\001\157\001\149\001\175\001\176\000\000\0034\0033\0037\000\000\000\000\000\024\001B\000\188\000\000\000\216\000\217\000\023\000\000\000\000\001\199\001\198\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003/\000\000\0030\000\000\000\000\003-\000\000\003,\003(\0022\000\000\003+\000\000\0023\000\000\000\000\000\000\000\000\000j\000\000\000\000\000h\000\000\000\000\001@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\184\001N\000\000\000\000\000\000\000\000\000\000\000\000\002\029\000\000\000\000\000\000\000\000\000\000\000\000\000e\000\000\000\000\000\000\000\000\001L\000\000\000\000\001O\001M\001U\000A\002\134\000\000\001\018\000\000\000\000\000\000\000\015\000\014\000\000\000\000\000\000\000\000\002\179\000\000\002e\002f\000\000\002c\002d\000\000\000\000\000\000\000\000\000\000\001e\001d\000\000\002\177\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\016\003\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000g\000\000\000\231\000\000\002h\002g\000\000\000\000\000\000\001\181\000\000\000\000\000%\000\000\000\000\000\000\000\000\000\000\001T\000\000\001S\000\000\001C\001R\000\000\001A\000b\000\030\000\000\000\000\001|\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\002<\002.\000\000\000\"\000\000\002/\000\000\000\000\001\178\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\017\003\017\000\000\003\018\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\184\000f\000i\000d\002\173\0038\002\174\001\239\002\176\000\000\000\000\002\181\002b\002\183\000\000\000\000\000\000\002\190\002\187\000\000\000\000\000\000\001\236\001\222\000\000\000\000\000\000\000\000\001\226\000\000\001\221\000\000\001\238\002\196\000\000\001\237\000q\001\229\000\000\000o\000\000\002\189\002\188\000\000\001\232\000\000\000\000\001\228\000\000\000\000\001\224\001\223\000\000\002\186\000\000\002j\002i\000\000\000\000\002F\002\185\002\182\000\000\000\000\000\000\000\000\001\183\001-\001.\002l\000\000\002m\002k\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\001o\000\000\000\000\000\000\000\000\000\000\000\000\003M\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003*\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002,\000\000\000\000\002-\000\000\000\000\001n\000\000\000\000\000\000\001K\001t\001J\001r\002 \002\031\000\000\001m\001l\000\000\000\205\000\000\000\000\001^\000\000\000\000\001b\000\000\001\203\001\202\000\000\000\000\001\201\001\200\001a\001_\000\000\001c\000\000\000\000\000\000\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\138\001P\002\143\002\141\000\000\000\000\000\000\002\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\172\000\000\002\171\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\250\000\000\000\000\000\000\000\000\000\000\000\000\000\239\001\249\000\240\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\234\000\000\000\235\000\000\000\000\000\000\002\151\000\000\000\000\000\000\002r\002q\000\000\000\000\000\000\000\000\0039\002\153\002\140\002\139\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\002M\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\002\250\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\002\251\002\252\000\000\000\000\000p\000\000\002\191\002\175\000\000\002\194\000\000\002\193\002\192\000\000\000\000\000\000\000\000\000\000\000\000\000\248\000\000\000\000\002&\000\000\000\000\000\000\000\247\000\000\000\000\000\246\000\245\000\000\000\000\000\000\000\000\000\250\000\000\000\000\000\249\000\000\001\235\000\000\000\000\001\246\000\000\000\000\001\248\000\000\000\000\001\244\001\243\001\241\001\242\000\000\000\000\000\000\000\000\000\000\001\024\000\018\000\252\000\000\000\000\000\000\002t\002s\000\000\000\000\002\130\002\129\000\000\000\000\000\000\000\000\002~\002}\000\000\000\000\002@\000\000\000\000\002|\002{\000\000\000\000\002\128\002\127\002\147\000\000\000\000\000\000\000\000\000\000\002x\000\000\000\000\000\000\000\000\000\000\002v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\002w\000\000\000\000\002u\000\000\000\000\002y\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\0010\000\000\0011\001/\002(\000\000\000\000\002)\002'\000\000\000\000\000\000\000\000\000\000\001\003\000\000\000\000\001\004\000\000\000\000\000\170\000\000\001\006\001\005\000\000\000\000\002\155\002\148\000\000\002\164\000\000\002\165\002\163\000\000\002\169\000\000\002\170\002\168\000\000\000\000\002\150\002\149\000\000\000\000\000\000\002\016\000\000\001\197\000\000\000\000\000\000\002I\002\015\000\000\002\159\002\158\000\000\000\000\000\000\001Q\000\000\002\132\000\000\002\133\002\131\000\000\002\157\002\156\000\000\000\000\000\000\002C\002\146\000\000\002\145\002\144\000\000\002\167\002\166\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\001X\000\000\000\000\000\000\000k\000\000\000\000\000l\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\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\014\000\000\000\000\000\251\001\195\000\000\000\237\000\238\001\002\000\000\000\000\000\000\000\000\000\000\001\210\001\204\000\000\001\209\000\000\001\207\000\000\001\208\000\000\001\205\000\000\000\000\001\206\000\000\001\144\000\000\000\000\000\000\001\143\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001s\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\t\000\000\000\000\003\b\000\000\000\000\000\000\000\000\000\000\001\255\000\000\000\000\000\000\000\000\000\000\000\000\003\014\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\128\000\000\002\005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\249\000\000\000\000\002N\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\146\000\000\000\000\000\000\001\145\000\000\000\000\000\000\000\000\000\000\001g\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\001\016\002\\\000\000\000\000\000\000\002Z\000\000\000\000\000\000\002Y\000\000\001Z\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\003A\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{\000\000\001z\000\000\000\000\000\000\000\000\000H\000\000\000\000\000\000\002\012\000\000\002\011\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\012\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\n\002`\002R\000\000\002X\002S\002^\002]\002[\001\027\000\000\002P\000\000\000\000\000\000\000\000\000\000\002\029\000\000\000\000\001\020\002T\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\139\001\135\000\000\000\000\000\000\000\210\000\000\000\000\002\019\002\029\000\000\000\000\001\022\002\017\002\018\000\000\000\000\000\000\000\000\000\000\001\142\001\138\001\134\000\000\000\000\000\211\000\000\000\000\001\141\001\137\001\133\001\131\002U\002Q\002a\001\026\001\252\002O\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003<\000\000\000\000\003>\000\000\0006\000\000\000\000\003D\000\000\003C\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003;\000\000\000\000\003=\000\000\000\000\000\000\002\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001?\000\000\000\000\001=\001;\000\000\0007\000\000\000\000\003G\000\000\003F\000\000\000\000\000\000\0019\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001>\000\000\000\000\001<\001:\000\000\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\000\254\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\000\255\000\000\000@\000-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\253\000\000\000V\000U\000\000\000\000\000[\000Z\000\000\000\000\001\185\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\b\003\012\003\003\000\000\000\000\003\007\002\248\003\002\003\011\003\n\001\031\000\000\000\000\003\000\000\000\003\004\003\001\003\r\001\251\000\000\000\000\002\254\000\000\000\191\002\253\000\000\000\000\000\222\000\000\000\000\001\030\001\029\000\000\001\\\001[\000\000\000\000\002\195\002\178\000\000\000B\000\000\000\000\000C\000\000\000\000\000\142\000\141\002\162\000\000\002\161\002\160\002\142\000\000\000\000\000\000\000\000\002\135\000\000\002\137\000\000\002\136\000\000\002o\002n\000\000\002p\000\000\000\000\000\134\000\000\000\000\002\004\000\215\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\189\000\000\003\006\002\024\002\025\002\020\002\022\002\021\002\023\000\000\000\000\000\000\000\190\000\000\000\000\002\029\000\000\000\214\000\000\000\000\000\000\000\000\003\005\000\000\000\187\000\000\000\000\000\000\000\000\0018\0012\000\000\000\000\0013\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\140\001\136\000\000\001\132\003&\000\000\002\029\000\000\000\213\000\000\000\000\000\000\000\000\002W\002\028\002\026\002\027\000\000\000\000\000\000\002\029\000\000\000\212\000\000\000\000\000\000\000\000\002V\000\000\001i\001h\000\000\000\022\000\000\003?\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\001E\001F\000\003\000\000\000\000\000\000\000\000\001H\001I\001G\000\019\001D\000\020\000\000\001\211\000\000\000\004\000\000\001\212\000\000\000\005\000\000\001\213\000\000\000\000\001\214\000\006\000\000\000\007\000\000\001\215\000\000\000\b\000\000\001\216\000\000\000\t\000\000\001\217\000\000\000\000\001\218\000\n\000\000\000\000\001\219\000\011\000\000\000\000\000\000\000\000\000\000\003\025\003\020\003\021\003\024\003\022\000\000\003\029\000\012\000\000\003\028\000\000\001%\000\000\000\000\003\026\000\000\003\027\000\000\000\000\000\000\000\000\001)\001*\000\000\000\000\001(\001'\000\r\000\000\000\000\000\000\0032\000\000\0031")
+ (16, "\000\000\000\000\000\000\002\247\002\246\002\245\002\244\002\243\002\198\002\242\002\241\002\240\002\239\002\238\002\237\002\236\002\235\002\234\002\233\002\232\002\231\002\230\002\229\002\228\002\227\002\226\002\225\002\224\002\197\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\002\204\002\203\002\202\002\201\002\200\002\199\000\000\000\000\000*\000\186\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003<\001\168\001\147\001\165\001\164\001\163\001\169\001\173\000\000\003=\001\167\001\166\001\148\001\171\001\162\001\161\001\160\001\159\001\158\001\156\001\172\001\170\000\000\000\000\000\000\000\220\000\000\000\000\001\151\000\000\000\000\000\000\001\153\000\000\000\000\000\000\001\155\001\177\001\174\001\157\001\149\001\175\001\176\000\000\003;\003:\003>\000\000\000\000\000\024\001B\000\188\000\000\000\216\000\217\000\023\000\000\000\000\001\199\001\198\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0037\000\000\0032\000\000\000\000\0034\000\000\0036\000\000\0033\0035\000\000\003-\000\000\003,\003(\0022\000\000\003+\000\000\0023\000\000\000\000\000\000\000\000\000j\000\000\000\000\000h\000\000\000\000\001@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\184\001N\000\000\000\000\000\000\000\000\000\000\000\000\002\029\000\000\000\000\000\000\000\000\000\000\000\000\000e\000\000\000\000\000\000\000\000\001L\000\000\000\000\001O\001M\001U\000A\002\134\000\000\001\018\000\000\000\000\000\000\000\015\000\014\000\000\000\000\000\000\000\000\002\179\000\000\002e\002f\000\000\002c\002d\000\000\000\000\000\000\000\000\000\000\001e\001d\000\000\002\177\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\016\003\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000g\000\000\000\231\000\000\002h\002g\000\000\000\000\000\000\001\181\000\000\000\000\000%\000\000\000\000\000\000\000\000\000\000\001T\000\000\001S\000\000\001C\001R\000\000\001A\000b\000\030\000\000\000\000\001|\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\002<\002.\000\000\000\"\000\000\002/\000\000\000\000\001\178\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\017\003\017\000\000\003\018\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\184\000f\000i\000d\002\173\003?\002\174\001\239\002\176\000\000\000\000\002\181\002b\002\183\000\000\000\000\000\000\002\190\002\187\000\000\000\000\000\000\001\236\001\222\000\000\000\000\000\000\000\000\001\226\000\000\001\221\000\000\001\238\002\196\000\000\001\237\000q\001\229\000\000\000o\000\000\002\189\002\188\000\000\001\232\000\000\000\000\001\228\000\000\000\000\001\224\001\223\000\000\002\186\000\000\002j\002i\000\000\000\000\002F\002\185\002\182\000\000\000\000\000\000\000\000\001\183\001-\001.\002l\000\000\002m\002k\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\001o\000\000\000\000\000\000\000\000\000\000\000\000\003T\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003*\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002,\000\000\000\000\002-\000\000\000\000\001n\000\000\000\000\000\000\001K\001t\001J\001r\002 \002\031\000\000\001m\001l\000\000\000\205\000\000\000\000\001^\000\000\000\000\001b\000\000\001\203\001\202\000\000\000\000\001\201\001\200\001a\001_\000\000\001c\000\000\000\000\000\000\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\138\001P\002\143\002\141\000\000\000\000\000\000\002\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\172\000\000\002\171\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\250\000\000\000\000\000\000\000\000\000\000\000\000\000\239\001\249\000\240\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\234\000\000\000\235\000\000\000\000\000\000\002\151\000\000\000\000\000\000\002r\002q\000\000\000\000\000\000\000\000\003@\002\153\002\140\002\139\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\002M\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\002\250\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\002\251\002\252\000\000\000\000\000p\000\000\002\191\002\175\000\000\002\194\000\000\002\193\002\192\000\000\000\000\000\000\000\000\000\000\000\000\000\248\000\000\000\000\002&\000\000\000\000\000\000\000\247\000\000\000\000\000\246\000\245\000\000\000\000\000\000\000\000\000\250\000\000\000\000\000\249\000\000\001\235\000\000\000\000\001\246\000\000\000\000\001\248\000\000\000\000\001\244\001\243\001\241\001\242\000\000\000\000\000\000\000\000\000\000\001\024\000\018\000\252\000\000\000\000\000\000\002t\002s\000\000\000\000\002\130\002\129\000\000\000\000\000\000\000\000\002~\002}\000\000\000\000\002@\000\000\000\000\002|\002{\000\000\000\000\002\128\002\127\002\147\000\000\000\000\000\000\000\000\000\000\002x\000\000\000\000\000\000\000\000\000\000\002v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\002w\000\000\000\000\002u\000\000\000\000\002y\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\0010\000\000\0011\001/\002(\000\000\000\000\002)\002'\000\000\000\000\000\000\000\000\000\000\001\003\000\000\000\000\001\004\000\000\000\000\000\170\000\000\001\006\001\005\000\000\000\000\002\155\002\148\000\000\002\164\000\000\002\165\002\163\000\000\002\169\000\000\002\170\002\168\000\000\000\000\002\150\002\149\000\000\000\000\000\000\002\016\000\000\001\197\000\000\000\000\000\000\002I\002\015\000\000\002\159\002\158\000\000\000\000\000\000\001Q\000\000\002\132\000\000\002\133\002\131\000\000\002\157\002\156\000\000\000\000\000\000\002C\002\146\000\000\002\145\002\144\000\000\002\167\002\166\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\001X\000\000\000\000\000\000\000k\000\000\000\000\000l\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\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\014\000\000\000\000\000\251\001\195\000\000\000\237\000\238\001\002\000\000\000\000\000\000\000\000\000\000\001\210\001\204\000\000\001\209\000\000\001\207\000\000\001\208\000\000\001\205\000\000\000\000\001\206\000\000\001\144\000\000\000\000\000\000\001\143\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001s\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\t\000\000\000\000\003\b\000\000\000\000\000\000\000\000\000\000\001\255\000\000\000\000\000\000\000\000\000\000\000\000\003\014\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\128\000\000\002\005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\249\000\000\000\000\002N\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\146\000\000\000\000\000\000\001\145\000\000\000\000\000\000\000\000\000\000\001g\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\001\016\002\\\000\000\000\000\000\000\002Z\000\000\000\000\000\000\002Y\000\000\001Z\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\003H\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{\000\000\001z\000\000\000\000\000\000\000\000\000H\000\000\000\000\000\000\002\012\000\000\002\011\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\012\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\n\002`\002R\000\000\002X\002S\002^\002]\002[\001\027\000\000\002P\000\000\000\000\000\000\000\000\000\000\002\029\000\000\000\000\001\020\002T\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\139\001\135\000\000\000\000\000\000\000\210\000\000\000\000\002\019\002\029\000\000\000\000\001\022\002\017\002\018\000\000\000\000\000\000\000\000\000\000\001\142\001\138\001\134\000\000\000\000\000\211\000\000\000\000\001\141\001\137\001\133\001\131\002U\002Q\002a\001\026\001\252\002O\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003C\000\000\000\000\003E\000\000\0006\000\000\000\000\003K\000\000\003J\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003B\000\000\000\000\003D\000\000\000\000\000\000\002\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001?\000\000\000\000\001=\001;\000\000\0007\000\000\000\000\003N\000\000\003M\000\000\000\000\000\000\0019\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001>\000\000\000\000\001<\001:\000\000\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\000\254\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\000\255\000\000\000@\000-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\253\000\000\000V\000U\000\000\000\000\000[\000Z\000\000\000\000\001\185\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\b\003\012\003\003\000\000\000\000\003\007\002\248\003\002\003\011\003\n\001\031\000\000\000\000\003\000\000\000\003\004\003\001\003\r\001\251\000\000\000\000\002\254\000\000\000\191\002\253\000\000\000\000\000\222\000\000\000\000\001\030\001\029\000\000\001\\\001[\000\000\000\000\002\195\002\178\000\000\000B\000\000\000\000\000C\000\000\000\000\000\142\000\141\002\162\000\000\002\161\002\160\002\142\000\000\000\000\000\000\000\000\002\135\000\000\002\137\000\000\002\136\000\000\002o\002n\000\000\002p\000\000\000\000\000\134\000\000\000\000\002\004\000\215\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\189\000\000\003\006\002\024\002\025\002\020\002\022\002\021\002\023\000\000\000\000\000\000\000\190\000\000\000\000\002\029\000\000\000\214\000\000\000\000\000\000\000\000\003\005\000\000\000\187\000\000\000\000\000\000\000\000\0018\0012\000\000\000\000\0013\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\140\001\136\000\000\001\132\003&\000\000\002\029\000\000\000\213\000\000\000\000\000\000\000\000\002W\002\028\002\026\002\027\000\000\000\000\000\000\002\029\000\000\000\212\000\000\000\000\000\000\000\000\002V\000\000\001i\001h\000\000\000\022\000\000\003F\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\001E\001F\000\003\000\000\000\000\000\000\000\000\001H\001I\001G\000\019\001D\000\020\000\000\001\211\000\000\000\004\000\000\001\212\000\000\000\005\000\000\001\213\000\000\000\000\001\214\000\006\000\000\000\007\000\000\001\215\000\000\000\b\000\000\001\216\000\000\000\t\000\000\001\217\000\000\000\000\001\218\000\n\000\000\000\000\001\219\000\011\000\000\000\000\000\000\000\000\000\000\003\025\003\020\003\021\003\024\003\022\000\000\003\029\000\012\000\000\003\028\000\000\001%\000\000\000\000\003\026\000\000\003\027\000\000\000\000\000\000\000\000\001)\001*\000\000\000\000\001(\001'\000\r\000\000\000\000\000\000\0039\000\000\0038")
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\021\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\002 \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\000\000\000\000\000\000\0000\000\002\b\016L\000@\000\000\000\000\000\000\000\003\000\000 \129\004\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000 \128\004\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000 \128\004\000\000\000\000\000\000\000\000\000\000 \000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\128\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\132\128\"\130\b \002\024\000\016\000v\001\018\000@2\000\007\129\000\012\\(\000\016\b\002\000\001\000\132\128\"\128\012 \146\028\000\017\000f\017\006\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003 \000p\016\000\197\194\128\001\000\128 \000\016\0000\000\135\001\002\012\\ \000\016\000\000\000\128\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`\022a\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\003\000\000`\000\000\197\194\000\001 \000 \000\000\000\016\001\000\000\000\004\000\000\000\018\000\000\000@\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\133\000\145\160\000\018B\028\012\001 \018\017 \001\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\002\012\016L\000@\000\000\000\000\000\000\000\003\000\000 \129\004\192\004\000\000\000\000\000\000\000\0000\000\002\b\016L\000\000\000\000\000\000\000\000\000\003\000\000 \128\004\192\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\000G\223d@\130\2545\000\004\193\193\2388\176(4'\225\"\213\138\173\2433\208\020\015\224\000\007\142\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\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\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\000\000\000\000\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\254\183\127\217\190\255\127\255\193\211\254b\0169\228\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n6\024\132~*\223R=>b\249\004\001\154\235\129!\bD\000\128\193#\144\000\001\128\000\001\140\0026\016\004X(\223\018=\000@\248\000\000\028\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\128@\002\130\020\012\000\000\002\001\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\0002\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\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\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\b2\024\132~\002\206R->2\027\004\001\146\203\128\000\b\000\000\000\000\000\016\000\001\000\000\000\000\b0\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@@\000 \193\000\000\000\016\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\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\n~\018\012X\170\2233}\001@\254 \0008\224\167\225 \197\138\173\2433\208\020\015\226\000\003\142\n~\018,X\170\2233=\001@\254`\0008\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016 \004\004\000\b\016@\000\001\000\000\000\000\128\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\000P \004\000\000\b\016\000\000\001\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\000\000\000\000\000\000\000\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\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\0002\016\004\b\000L\018-\000\016\024\000\000\016@\003!\000@\128\004\193\"\208\001\001\160\000\001D\0002\016$\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\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\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\017\000\000\000\000\000\000\000\000\016\000\004\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\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'\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\000p\016\000\197\194\000\001\000\000\000\000\020\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\016\000\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\000\000\000\128\000\000\b\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\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\003\000\000p\016\000\197\194\000\001\000\000\000\000\004\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\196\128;\128\b2\018\028\012\017 v\001b\017`0\000\007\001\000\012\\ \000\016\000\000\000\000\000\196\128\187\128\b2\018\028\012\017 v\001b\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\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\001b\017`\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\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\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\197\128\187\128\b2R\028\012\017 v\001b\017`0\000\006\000\000\012\\ \000\016\000\000\000\000\000\197\128\187\128\b2R\028\012\017 v\001b\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\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\003\000\000p\016\000\197\194\000\001\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\004\000\000\004\000\000 \000\000\000\016\0000\000\007\001\000\012\\ \000\016\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\016 0\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\002\000\000\000\001\018\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\002\000\000\000\000\004\000\000 \000\000\000\017 \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\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\128;\128\b2\018\028\012\017 v\001b\017@\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\001\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\004\000\000\000 \000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\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\002\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\002\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\128\000\017\000\000\000\000\004\000\000\000\016\000\000\000\b\000\001\016\000\000\000\000\000\000\000\001\000\000\000\000\003!\000@\128\004\193\"\208\001\001\160\000\001\004\0002\016\004\012\000L\018i\000\016\024\000\000\016@\003!\000@\128\004\193&\144\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\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\018k\000\016\025B\006\213P\000\001\000\000\128\004\000\000\016\000\001\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\147)\027P\144\020\193&\240\001\001\180\016mU\000\016\000\000\000\000\b\002(\000\000\000\000\000\000\000\131!\b@\128\004\193\"\208\001\001\160\000\t\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\016\004\012\000L\018m\000\016\026\000\000\016@\003!\000@\128\004\193&\208\001\001\160\000\001\004\0002\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\000\000\000\000\000\000\144\000\027\000\000\016\000\004\000\000\000\020\000LQ\0002\016\004\b\000L\018-\000\016\026\000\000\016@\144\000\027\000\000\016\000\004\000\000\000\020\000LQ\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\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\147!\027@\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\000\004\000\000\000\000\000H\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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@\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\b\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\017\000\000\000\000\004\000\000\000\000\000H\017\b\000\001\016\000\000\000\000\000\000\000\000\000\000\000\000\131\000\001\000\000\000@\000\000\000\000\000\000\000\000\b\000\001\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\0002\144\005\t\000L\018k\000\016\025\000\004\209P\000\000\000\000\000\000\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\016\000\004\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\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\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\016\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\003!\004@\200$\193&\208\001\001\160\000\001\004\000\016 \004\004\000\b\016@\000\001\000\000\000\000\128\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\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\0000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\001\000@@\000 \193\000\000\000\016\000\000\000\000\000\016\004\004\000\002\012\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\000\000\000\000\000\016\128\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\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\0000\000\002\b\000L\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\003\000\000x\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\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\012H\002\168\000\131\001!\192\001\016\007`\002 \020\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 \020\196\128*\128\b0\018\028\000\017\000v\001\"\000@0\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\196\128*\128\b0\018\028\000\017\000v\001\"\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\001\001\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\001\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\196\128*\128\b0\146\028\000\017\000v\016\"\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\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\018\028\000\017\000v\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\004\000\000\000\000\000\000\000\000\000\196\128*\128\b0\146\028\000\017\000v\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\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\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\016\128\000\000\000\000\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\000\000\000\000\000\000\000\000\000\012H\002\168\000\131\t!\192\001\144\007`\002`\004\005\002\b@\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\128\000\b\000\000\000\128\004\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\004\004\000\002\012\016\000\000\001\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\000\000\000\000\000\000\000\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\144\007a\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\128\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\0026\016$X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000@\000\000\000@\000\000\000\000\b\000\001\000\000\000\000\000\000\000\004\001\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\018\016\004@\b\012\0189\000\000\024\000\000\024\192\192\000\017\000\000\000\000\000\000\003\000\016P$\000\0026\016\004\\(\223\018}\000@\248 \000\024\224#a\000E\130\141\241'\208\004\015\130\000\001\142\0026\016\004X(\223\018=\000@\248 \000\024\224\001!\000D@\128\193'\144\000\001\128\000\001\140\000\018\016\004@\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\189\187\215\248\190\215?\191\251a\247\219\127\253\240\016\000\000\000\000\012\0028\000\000\000\000\000\000\000\163a\136G\226\173\245#\211\230/\144@\025\174\176\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\163a\bE\130\141\241#\208\004\015\128\000\001\142\n6\016\132X(\223\018=\000@\248\000\000\024\224\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\000\000\000\b\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\163a\bE\130\141\241#\208\004\015\128\000\001\142\n6\016\132X(\223\018=\000@\248\000\000\024\224\131!\b@\128\004\193\"\208\001\001\128\000\001\004\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\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\003!\000@\192\004\193&\208\001\001\160\000\001\020\0002\016\004\b\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\016@\016\000\000\000\000\016\000\004\000\000\000\000\000H\017\0026\016\004X(\223\018=\000@\248\000\000\024\224\003)\000P\208\004\193&\176\001\001\128\000\001\004\0002\144\005\t\000L\018k\000\016\024\000\000\016@\003)\000P\144\004\193\"\176\001\001\128\000\001\004\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\0002\016\004\b\000L\018-\000\016\026\000\000\016@\000\000\b\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\b\000\000\000\000\004\000\000\000\016\000\000\000\000\000\000\128\000\000\000\000\000\000\000\001\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\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\144\005\t\001L\018+\000\016\024\000\000P@#a\000E\130\141\241#\208\004\015\128\000\001\142\0002\016\004\012\000L\018m\000\016\026\000\000\016@\003!\000@\128\004\193&\208\001\001\160\000\001\004\0002\016\004\b\000L\018-\000\016\026\000\000\016@\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\001!\000D@\128\193'\144\000\001\128\000\001\140\000\018\016\004@\b\012\018y\000\000\024\000\000\024\192\001!\000D\000\128\193#\144\000\001\128\000\001\140\012IK\184>\131\225a\192\255\182\007}\183\231\015\001!\000D\000\128\193#\144\000\001\128\000\001\140\012[\219\189\127\139\237s\251\255\182\031}\183\255\223\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#a\000E\130\141\241#\208\004\015\128\000\001\142\012[\219\189\127\139\237s\251\255\182\031}\183\255\207\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001!\000D\000\128\193#\144\000\001\128\000\001\140\012[\219\189\127\139\237s\251\255\182\031}\183\255\223\000\000\000\000\000\000@\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\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\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\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\240\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\004#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\196\148\187\131\232>\022\028\015\249`w\139~p\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\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\197\189\187\215\248\190\215?\191\251a\247\219\127\252\252IK\184>\131\225a\192\255\182\007}\183\231\015#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\231\245\187\199\234\191\247?\223\253o\247\139\127\254\247\223d@\130\2545\000\004\193\193\2388\176(4#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\196\148\187\131\232>\022\028\015\249`w\139~p\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\196\148\187\131\232>\022\028\015\249`w\139~p\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\196\148\187\131\232>\022\028\015\249`w\139~p\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\196\148\187\131\232>\022\028\015\249`w\139~p\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\196\148\187\131\232>\022\028\015\249`w\139~p\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\196\148\187\131\232>\022\028\015\249`w\139~p\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\196\148\187\131\232>\022\028\015\249`w\139~p\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\196\148\187\131\232>\022\028\015\249`w\139~p\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\196\148\187\131\232>\022\028\015\249`w\139~p\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\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\2402\016\004\b\000L\018m\000\016\024\000\000\016@\003!\000@\128\004\193\"\208\001\001\128\000\001\004\0002\144\005\t\000L\018k\000\016\025\000\006\209P\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\000L\018+\000\016\025\000\002P@\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#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\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\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\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\002P@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\000\000\016\000\001\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\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\000\000\000\000\000\000\000\000\000\000\000\000\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\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\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\132\128\"\128\b \018\024\000\025\000f\000\002\000HH\002(\000\130!!\128\193\144\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\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\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\b\016>\000\192@@>\002\001\000\005\130\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\155\003\224\012\004\004\003\224 \016\000X`:6\016\180X(\223\018=\000@\248\000\000\028\224\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\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\000\000\000\000\001!\000D\000\128\193#\144\000\001\128\000\001\140\012[\219\189\127\139\237s\251\255\182\031}\183\255\223\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\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\000\000\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\000\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\128\000\145\003\224\012\004\004\003\224 \016\000X 0\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\129\003\224\012\004\004\003\224 \016\000X <[\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\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\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\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\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\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\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\000\000\128\000\002\002\028\012\000\000\018\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\b\000\000 !\192\192\000\001 \016\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\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\000\000\000\000\000\000\000 \000\002\b\000L\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\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\000\000\000\000\000\000\000 \000\002\b\000L\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\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\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\002 \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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\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\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\0002\016$\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\018\000\000\000\000\004\000\000\000\000\000HQ\b2\016$\b\000L\018-\000\016\026\000\000\020@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\001\001\144\000M\021\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\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\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\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\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\002 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\004\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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@\003)\000P\144\004\193&\176\001\001\144\000m\021\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\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\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\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\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\131\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\002\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\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\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\000\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\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\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\b\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000H\017\0002\016\004\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\004\000\000\000\016\000H\017\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\129\003\224\012\004\004\003\224 \016\000X 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\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\000\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\248\000\t\016>\000\192@@>\002\001\000\005\130\003\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\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\b\016>\000\192@@>\002\001\000\005\130\003\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\240\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\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\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\237s\251\255\182\031}\183\255\223\197\189\187\215\248\190\215?\191\249a\247\139\127\252\240\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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#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\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\002\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\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\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\0000\000\006\000\000\012\\ \000\016\000\000\000\000\000\001\000\000\000\000\016@\000\000\001\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\0002\144\005\t\001L\018+\000\016\024\000\000P@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\144\005\t\001L\018+\000\016\024\000\000P@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\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#a\000E\130\141\241#\208\004\015\128\016\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\148\187\131\232>\022\028\015\249`w\139~p\2402\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\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\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\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\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\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\b#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!\000@\128\004\193\"\208\001\001\128\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\018\016\132@\b\012\0189\000\000\024\000\000\024\192\128\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\028\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\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#a\002E\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\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\004\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\018\016\004@\b\012\0189\000\000\024\000\000\024\192@\000\000\000\000\000\000\000\000\003\000\000P\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\b\000\001\016\000\000\000\000\000\000\000\001\000\002@\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\000\128\000\017\000\000\000\000\000\000\000\000\000\000\000\000\b\016\000\016\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\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\004\000\000\000\000\000\000\000\000\0000\000\005\000\000\000\001\000\000\000\000\000\192#\128\000\000\000\000\000\000\012\000\001\016\000\000\000\000\000\0000\001\005\002@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012IK\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\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\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\t\016>\000\192@@>\006\001\000\005\130\003\128\000\016\000\000\000\000\000\000\000@\000\000\000\000\b\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\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\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\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\000\000\000\b\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\003\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\b\000\000\000\000\001\000\000@\000\001\002\000@\000\000\129\000\000\000\016\000\000\000\000\bH\002(\000\130\t!\192\001\144\006`\000 \004\001\000@@\000 \193\000\000\000\016\000\000\000\000\004\000\000\000\000\001\000\000@\000\000\001\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\144\006`\000 \004\000\000\000\000\000\000\000\000\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\000\000\000\000\000\000\b\000\000\000\000\001\000\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\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\128\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\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\003\000\000`\000\000\197\194\128\001\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\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\016\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\017\000\000\000\000\004\000\000 \000\000\000\001\000\000\001\016\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\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\001\016\000\000\000\000@\000\002\000\000\000\000\016\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000`\000\000\197\194\000\001\000\000\000\000\000\bX\n(\000\131\005!\192\001\144\006`\016!\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bX\n(\000\130\005!\192\001\144\006`\016!\004\003\000\000`\000\000\197\194\128\001\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\003\000\000`\000\000\197\194\000\001\000\000\000\000\000\bX\002(\000\130\005!\192\001\144\006`\016!\004\133\128\162\128\b0R\028\000\025\000f\001\002\016@\000\000\000\000\000\000\000@\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\004@\128\004\193&\208\001\001\128\000\001\004\0002\016D\b\000L\018-\000\016\024\000\000\016@\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@\132\128\"\128\b \018\024\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\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\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\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\004\000\000\000\016\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\132\129\"\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\024\000\017\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\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\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\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\024\162\211?\188\017\001\230\001\007\141HZ\146\173A\138-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\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\b\000\000\000\128\004\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\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\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\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\131!\000@\128\004\193\"\208\001\001\160\000\001\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\000\000\000\000\000\000\000\000\000\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\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\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\016\000\018\000\000\000\000\b\000 \000\000\b\000\000\000\000\132\128\"\128\b \018\028\000\017\000f\000\002\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\024\000\017\000f\000\002\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\000v\000\006\016\000\018\000\000\000\000\b\000 \000\000\b\000\000\000\000\132\128\"\128\b \018\028\000\017\000f\000\002\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\000\000\000\000\000\000\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\132\128\"\128\b \018\024\000\017\000f\000\002\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\004\000\000 \000\000\000\000\000\000\001\000\000\000\000\000\000\000\002\000\000\000\000\000\003\000\000`\000\000\197\198\000\001 \000 \000\000\0000\000\006\000\000\012\\ \000\018\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\016\000\000\000@\000\000\001 \000\000\000\000\0000\000\006\000\000\012\\ \000\018\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\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\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\128\000\000\000\000\000\000\000\000\000\004\000\000\001\000\000\000\000\000@\000\000\001\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\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\004\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\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\004\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\132\128\"\128\b \018\028\000\017\000f\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\000\007\129\000\012\\(\000\016\b\002\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\000!\128\001\000\006`\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\132\128\"\128\b \002\024\000\016\000f\000\002\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\132\128\"\130\b \002\024\000\016\000v\001\018\000@2\000\007\129\000\012\\(\000\016\b\002\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\000!\128\001\000\006`\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\132\128\"\128\b \002\024\000\016\000f\000\002\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\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\001!\192\001\016\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\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\000\000\000\000\000\000\000\000\000\000\000\000\002\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\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\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\000!\000\001\000\006@\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\018\000\000\000\000\012\000 \000\000\b\000\000\000\000\128\000\136\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\b\000\000\000\000\000\001\000\000\000\001\000\000\000\000\000\192\000\000\000\000\000\000\000\000\b\000\b\000~\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\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\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\0026\016\004X(\223\018=\000@\248\000\000\024\224\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\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\b\000\000\000\000\000A\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\000A\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\0002\016\004\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\004\000\000\000\004\000H\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\001\000\000\000\001\000\000\000\000\000\192\000\000\000\000\000\000\000\000\002~\018\012X\170\2233=\001P\254@\0008\224\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000Z\018\b\000\130\r!\001\001\016\014@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000H\002\b\000\130\001!\000\001\016\006A\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128 \128\b \018\016\000\016\000`\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\b\000\000\000\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\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002~\018\012X\170\2233=\001P\254@\0008\224'\225 \197\138\173\2433\208\021\015\228\000\003\142\000H\002\b\000\130\001!\000\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\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\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\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")
and start =
13
and action =
- ((16, "C\170P\226Ff\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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[\\(\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\006\168\000\218\000\000\003\188\t|\000\000\001\208\003\232\nt\000\000\000\244\004\198\011l\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\220\000\000\000\000\000\000\0046T\016\000\000\000\000\000\000\005.\000\000\000\000\000\000\005\022\005\b\000\000\000\000T\016H\254\020X\021\178^\128\020X\\\142Mj\020XB\146\000\000B\146\000\000\027\158\004\246\000\000\005.\000\000\000\000\000\000\002J\000\000\027\158\000\000\006&v\246]\160d\194\000\000\132l\134\028\000\000LP_\014\000\000X\\\026\206K\200\005.p\026FfC\170\000\000\000\000Mj\020XF\138B\146\007\012v\246\000\000\128\178FfC\170P\226\020X\000\000\000\000\016x\025\186\001N\b\198\000\000\002\138\b\252\000\000\000\000\000\000\000\000\000\000\020X\000\000A\206i\164C\170\000\000\000\000P\206\020XZ\024W\200\000\000\004\002\000\000\000\000\005\242\000\000\000\000H\166\004\002\024\138\003\130\0020\000\000\000\000\003\172\000\000\021\178\006f\006\154\020X\028\254\020XC\170C\170\000\000P\212P\148\020X\028\254E\166\020X\000\000\000\000\000\000P\226\020X\000\000\000\248\000\000W\200y\188zJ\000\000\b\198\000\000\n\"\000\000\000\000C,T\016\134h\000\000h\142\134h\000\000h\142h\142\000b\006:\0008\000\000\020\190\000\000\006\220\000\000\000\000\t\014\000\000\000\000\000\000h\142\005.\000\000\000\000V\222T\016T\132_\014\000\000\000\000N*\000b\000\000\000\000_\014\007\026T\016\000\000O _\014P\022\000\000\000\000\000\000\n\198\000\000h\142\000\000\001\000\1310\000\000T\016\005\216T\016\000\000\022\\\b&\005.\000\000\000\000\023\224\000\000\006\208\000\000Y\128\011\190\000\000\007\128h\142\011\230\000\000\012\182\000\000\007\200\000\000\000\000\004\184\000\000\000\000\000\000\021 4W\200P\206\020XW\200\000\000\000b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000M:\027v\000\000\000\000\000\000\001\244&\174t<\000\000\000\000P\206\020XW\200\000\000\000\000{hW\200\136.zJ\000\000\136v\000\000W\200\000\000\000\000X\180\000\000\000\000\000\000\b\162\000\000\022\168\000\000\000\000z\214\000\000\136\208{\030\000\000\137\018\t\002\000\000\000\000z\214\000\000\004\024\000\000\000\000DHt\200\000\000\000\000\000\000Bn\023|\019\252\023\176\000\000\000\000\000\000\000\000\004\250\000\000\000\000Z\204\b\164\t`\000\017T\016\002\204\n\204\000\000\000\000\t\246\t`\007X\000\000i\186P\234P\148\020X\028\254\000-\000\018\0020\000\000\n>\021\178\021\178\000-\000\018\000\018\021\178\000\000jL\0050B\146\b\198\000\236\137`\000\000T\016ebT\016_ f\002T\016\000\144T\016f\156\000\000\000\000\020d\0008_\192\b\130\0008`\024\000\000j\230\0050\000\000\021\178k\128\000\000\007\196\t\190`\184\000\000\000\000\000\000\000\000\000\000\000\000\001B\000\000\000\000\003\144\000\000\007|\028\254\000\000\\\192E\166\000\000\031\138\000\000\000\000\021\178\002\152\000\000\000\000\000\000\000\000[\132\000\000\001\200\000\000UP\001\130\005\"\000\000\0226V\170P\226\020XG,P\226\020X\016x\016x\000\000\000\000\000\000\000\000\001\240\024&B\188\000\000Q\150RJP\212\020X\028\254\007h\021\178\000\000\004*\000\000R\254S\178{\182I\190T\016\002\128\000\000P\226\020X\000\000u\016\020Xy\188W\200E\186\000\000P\226\020Xw\\\004~\000\000W\200A\012T\016\003x\007X\012<\000\000\000\000\000\000H\166\003\138\003\138\000\000\012Bp\156\000\000P\206\020XW\200\025R\000\000P\226\020X\016x\0226\016x\002\232\023\240\000\000\000\000\016x\012\014\000\000\r\000\000\000\016x\003\224\rX\000\000'\166\000\000\b\196\000\000\000\000\026\022\000\000\017p\023.\000\000\000\000\000\000\000\000\005\226\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^\020XW\200ZJI\146\003\138\014 l\012W\200\000\000\000\000\000\000h\142\000\000\028\018\134\028\000\000\026\"T\016\029\220\r\164\000\000\000\000\000\000\000\000l\012\000\000\000\000\005\242\014V\000\000I\128\000\000\000\000\135\176\000\000\007:\000\000\000\000K\200\003\138\r\202T\016\t\148\000\000\000\000\b\188\005.\000\000T\016\n@\000\000\000\000\r\252\000\000\000\000\000\000JjT\016\nP\000\000\000\000\030*\000\000\000\000{\254\000\000\031\"|\138\000\000 \026|\210\000\000!\018\t\250\000\000\000\000\000\000\000\000\"\nW\200#\002p\234p\234\000\000\000\000\000\0001V\000\000\007\204\000\000\000\000\000\000q\140\000\000\000\000\002\138\023\248\000\000\t*\000\000\000\000]bKl\000\000\000\000\t\188\000\000\000\000\000\000\n\128\000\000\000\000\000\000\016x\004\216\024\232\000\000\t`\000\000\005\208\000\0002N\000\000\n\180\000\000\006\200\000\0003F\000\000\014\204\007\192\000\0004>lt\000\000(\158\000\000\t\218\b\184\000\00056\000\000\011\150\t\176\000\0006.\000\000q\150\n\168\000\0007&\t\234\025\016\000\000\n\210\011\160\000\0008\030\000\000\011\216\012\152\000\0009\022\000\000\r\n\r\144\000\000:\014\014\136\000\000;\006\015\128\019`\000\000\000\000\000\000\011\026\000\000\000\000\012\186\000\000\000\000\015n\000\000\012*\000\000\000\000\000\000\014\222\000\000\015\004\000\000\000\000J~\003\138\015\192p\156_\014\000b\000\000\000\000p\156\000\000\000\000\000\000p\156\000\000\015\156\000\000\000\000\000\000\000\000\000\000\000\000;\254W\200\000\000\000\000\015\232\000\000<\246\000\000=\238\000\000#\250\000\000\000\000\n\184\000\000\000\000W\200\000\000\000\000}j\011\202\000\000\000\000G,\000\000\011\238\000\000\000\000V\020\000\000\rh\000\000\000\000\001\130\011\254\000\000\000\000\0226\022\028\b\198\000\000A\214\000\000!,\025\160\021\220\000\000\000\000\r\150\000\000\000\000\001\238\025\030V\180\000\000\025\030\000\000\012\246\000\000\000\000\r\172\000\000\000\000g>\b\n\004H\000\000\000\000\r@\000\000\000\000\r\200\000\000\000\000\000\000\020X\028\254\005\168\000\000\000\000\023Z\003\130\0020\003\136\028\254w\228\021\178\001B\028\254xb\015\144\000\000\000\000\003\136\000\000H\232\019\248\021\204\000\000\t\144\016\002\000\000\016\000\000V_\014\006\196\000\000\015\232\015vK\200\r(T\016\030\128\0204\014\n\004\248\000\000\031x\016N\000\000\006\196\000\000\000\000\016^_\014aX\000\000g\144_\014\016*_\014m\012a\248\001N\015\236\000\000\000\000\000\000\020X\128\252\000\000W\200p\234\000\000\000\000\016b\000\000\000\000\000\000>\230\016\146y\188?\222h<\000\000\000\000HJ\000\000\005\128\000\000L\136\000\000\022\222\000\000\021\178\006\026\000\000\128\178\000\000\020X\028\254\128\178\000\000\025D\025\186\001N\005.\130\144\021\178}\248p\234\000\000\005r\b\176\0020\003\136p\234\132\224\003\130\0020\003\136p\234\132\224\000\000\000\000\003\136p\234\000\000FfC\170W\200\027B\000\000\000\000FfC\170P\148\020X\028\254\128\178\000\000\020\182\000-\000[\015\200T\016\012\142\016\146\131P\000\000p\234\000\000H\232\019\248\021\204x\186\023\228\t\236~,\b\130\015\234\020Xp\234\000\000\020Xp\234\000\000h\142ff\019\134\002\222\001N\0008N\234\000\000\001N\0008N\234\000\000\025D\005r\t\168\0212\012\180\000\000N\234\000\000\0020\015\234\021\178p\234\134\222\003\130\0020\015\236\021\178p\234\134\222\000\000\000\000\b`\000\000O\224\000\000\021\178\131\132N\234\000\000\b`\000\000H\254\020X\021\178p\234\000\000H\232\019\248\021\204rFC\186\026\222\019\170\002\142\000\000\r\216\027\158\000\017\000\000\016h\016 \024\196\020XT\184T\016\0118\000\000W\150\001N\005\204\011\246\000\000\011\228\000\000\016~\016\014T\016O(\000\000\0032\004\212\r\200\000\000\r6\000\000\016\136\016 K\200\r\206T\016K\182O(\000\000UP\020X\024\196\016\202\n$\001N\000\000\r\200\024\196T\016\012~\000b\000\000T\016\007\152\t,\000\000\000\000mf\000\000\000\000\r\228\024\196m\228O(\000\000\020XT\016\r(T\016V\\O(\000\000\014<\000\000\000\000O(\000\000\000\000W\150\000\000p\234\132\238\019\170\002\142\r\216\016\182\016h\024\196p\234\132\238\000\000\000\000\019\170\002\142\r\216\016\190\016HM\252LZ_\014\016\206M\252h\142\020\184\016\218M\252_\014\016\230M\252n\132o\004\000\000\129\140\000\000\000\000p\234\134\236\019\170\002\142\r\216\016\224\016nM\252p\234\134\236\000\000\000\000\000\000ff\000\000\000\000\000\000\000\000\000\000\000\000N\234\000\000\133\128\020\026A\228\017\002v\246\000\000\128\178\133\128\000\000\000\000\1358\020\026A\228\017\004\016\158]\160\135\176\006\196\017H\000\000\000\000o\130rF\020X\000\000~\200\021\204\000\000\000\000\128\178\1358\000\000\000\000\000\000y6DlD\228\006\196\017J\000\000\000\000\000\000rF\020X\000\000\006\196\017N\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014`C\186\019\170\002\142\r\216\017 r\182\023\204\020XZ\024j\190\020(\001N\006\196\017*\nt\000\000\000\000\016\220\000\000\000\000a\152\000\000\b\022\014\132\000\000\r\212\000\000\0178\016\202T\016d\240\017F\n\158\000\000\000\000\017\004\000\000\000\000\020F\0032\014\210\000\000\017Zs8\137\172\003\138\016\248T\016\014r\000\000\000\000\017\012\000\000\000\000\000\000a\152\000\000\0070\014\234\000\000\014\204\000\000\017l\016\250K\200\000\000\017vs\186\137\248\003\138\017\026T\016\015\024\000\000\000\000\017,\000\000\000\000\000\000\020X\000\000a\152\000\000\020z\020X\023\204\023\204u\168Ff\020X\128\252W\200\021\162\000\000\012\020\001N\000\000\014\012\023\204T\016\014n\b\198\000\000\020XW\200r\182\023\204\014\154\023\204\000\000D\142Et\000\000bR\000\000\000\000b\238\000\000\000\000c\138\000\000\014\192\023\204d&\128\252W\200\021\162\000\000\000\"\000\000\000\000M\252\r\026\000\000\000\000d.\017\144\000\000a\152\000\000\023\204d.a\152\000\000\020XT\016a\152\000\000\015\136\000\000\000\000a\152\000\000\000\000j\190\000\000\129\192M\252\017T\023\204\130\\r\182\000\000p\234\133\142\019\170\002\142\r\216\017\174r\182p\234\133\142\000\000\000\000\000\000\135\248P\206\000\000\000\000\000\000\000\000\000\000\000\000\132\022p\234\000\000\133\128\000\000\000\000\000\000\000\000p\234\135\248\000\000\017\234\000\000\000\000\132\022\017\236\000\000p\234\135\248\000\000\000\000\015\222\000\000\000\000i4\0032\000\000\000\000DH\000\000T\016\015\242\000\000j\190\015\240\000\000\000\000\000\000\014\192\000\000\000\000\000\000P\212\020X\028\254\006\178\000\000Mt\000\000\007p\000\000\000*\000\000\000\000\017\242\000\000\018\026y\188\000\000@\214\017\252\000\000\000\000\017\248\026R\028B\021\204v0\023\228\020X\000\000\128\178\000\000\000\000\000\000\000\000\000\000\000\000\000\000v8\023\228\020X\000\000\015\"v\246\000\000\128\178\000\000\017\254\026R\028B\128\178\000\000\018\020\000\000\000\238\t\214\020X`\226\000\000\000\000\028\190y\242\000\000\000\000\017\184\000\000\018\bT\016\000\000\r\234\011\174\000b\000\000\000\000T\016\004R\006B\000\000T\016\012\018\006\196\018>\000\000\000\000\127\"\000\000\000\000]\160\000\000\128\178\000\000\0182\026R\029:N\234\000\000\000\000\000\000\000\000\015h\127\188]\160\000\000\128\178\000\000\0184\026R\029:N\234\000\000\016 \000\000\000\000\b\n\000\000p\234\000\000\018H\000\000\000\000\017\174\000\000\017\188\000\000\017\208\000\000\000\000\\\142\017\216\000\000\000\000%\182\\(\018t\000\000\000\000\000\000\014\242\011D]\232\018x\000\000\000\000\000\000\000\000\000\000\000\000\017\248\000\000\023\228\000\000\017\250\000\000T\016\000\000\014\250\000\000\000\000\017\252\000\000\000\000\0008\000\000\003\210\000\000\000\000\000\000\001\214\000\000\015\196\000\000\018\000\000\000W\200\022\168\000\000\000\000\012<\018\012\000\000\000\000\018\006\r$G,\005.\128:\000\000\000\000\000\000\000\000\000\000YL\000\000\000\000\018\172\000\000\138<\000\000\015\192\018\180\000\000\018\182\000\000G\224G\224[\190[\190\000\000\000\000p\234[\190\000\000\000\000\000\000p\234[\190\0180\000\000\018H\000\000"), (16, "\t)\t)\000\006\001\002\001\190\t)\002\158\002\162\t)\002\206\002f\t)\003\145\t)\018\130\002\218\t)\023\130\t)\t)\t)\025*\t)\t)\t)\001\210\004A\004A\004*\002\222\t)\003\"\003&\t\214\t)\001\206\t)\023\134\003*\000\238\002\226\025.\t)\t)\003\186\003\190\t)\003\194\003\022\003\206\003\214\006\186\006\246\t)\t)\002\150\001\206\006\214\003\030\t)\t)\t)\007\254\b\002\b\014\b\"\001*\005Z\t)\t)\t)\t)\t)\t)\t)\t)\t)\b\150\000\238\t)\015~\t)\t)\003\145\b\162\b\186\t\014\005f\005j\t)\t)\t)\r\162\t)\t)\t)\t)\002N\002~\r\210\t)\006\150\t)\t)\0035\t)\t)\t)\t)\t)\t)\005n\b\022\t)\t)\t)\b.\004V\t\"\0035\t)\t)\t)\t)\012\217\012\217\023\138\n\178\004~\012\217\n\190\012\217\012\217\000\238\012\217\012\217\012\217\012\217\004A\012\217\012\217\001f\012\217\012\217\012\217\003i\012\217\012\217\012\217\012\217\004A\012\217\015\222\012\217\012\217\012\217\012\217\012\217\012\217\012\217\012\217\007\162\007\002\0076\012\217\004\198\012\217\012\217\012\217\012\217\012\217\004A\012\217\012\217\004A\012\217\003\210\012\217\012\217\012\217\000\238\007\166\012\217\012\217\012\217\012\217\012\217\012\217\012\217\000\238\012\217\012\217\012\217\012\217\012\217\012\217\012\217\012\217\012\217\012\217\012\217\004A\012\217\012\217\007n\012\217\012\217\001j\004A\007\018\004A\012\217\012\217\012\217\012\217\012\217\004A\012\217\012\217\012\217\012\217\012\217\000\238\012\217\012\217\007\026\012\217\012\217\000\238\012\217\012\217\012\217\012\217\012\217\012\217\012\217\012\217\012\217\012\217\012\217\012\217\012\217\b\006\004A\012\217\012\217\012\217\012\217\001\181\001\181\001\181\001f\015>\001\181\003i\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\014\234\001\181\007\194\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\003j\003n\001\181\000\238\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\006\218\001\181\001\181\001\181\007\250\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\002J\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\027\159\001\181\001\181\018r\007\222\007\002\007R\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\014\174\bF\001\181\005\158\001\181\001\181\007\226\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\n]\n]\002\225\007n\012\253\n]\003\149\n]\n]\000\238\n]\n]\n]\n]\001\186\n]\n]\012\253\n]\n]\n]\000\238\n]\n]\n]\n]\002N\n]\000\n\n]\n]\n]\n]\n]\n]\n]\n]\024\194\007\002\b\146\n]\004A\n]\n]\n]\n]\n]\000\238\n]\n]\012\006\n]\002\246\n]\n]\n]\002\225\024\198\n]\n]\n]\n]\n]\n]\n]\004A\n]\n]\n]\n]\n]\n]\n]\n]\n]\n]\n]\003\149\n]\n]\007n\n]\n]\004A\004A\007\002\004A\n]\n]\n]\n]\n]\004\001\n]\n]\n]\n]\t:\000\238\tj\n]\005\241\n]\n]\007\174\n]\n]\n]\n]\n]\n]\n]\n]\n]\n]\n]\n]\n]\003v\n]\n]\n]\n]\n]\003\173\003\173\001r\007n\006\214\003\173\b\250\003\173\003\173\000\238\003\173\003\173\003\173\003\173\000\238\003\173\003\173\006\137\003\173\003\173\003\173\000\238\003\173\003\173\003\173\003\173\001\130\003\173\006>\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\006\137\007\002\004\001\003\173\004&\003\173\003\173\003\173\003\173\003\173\015.\003\173\003\173\006B\003\173\t\005\003\173\003\173\003\173\005\241\bv\003\173\003\173\003\173\003\173\003\173\003\173\003\173\0156\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\b\213\t2\tb\007n\003\173\003\173\003z\003B\b\202\027\143\003\173\003\173\003\173\003\173\003\173\0046\003\173\003\173\003\173\003\173\t:\000\238\tj\003\173\b\006\003\173\003\173\003F\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\018\222\b\206\b\234\003\161\0056\003\161\003\161\t\005\003\161\003\161\003\161\003\161\001\146\003\161\003\161\006~\003\161\003\161\003\161\0022\003\161\003\161\003\161\003\161\018\230\003\161\001\198\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\006\237\b\213\004A\003\161\0026\003\161\003\161\003\161\003\161\003\161\b\029\003\161\003\161\001\218\003\161\007\006\003\161\003\161\003\161\006\237\004A\003\161\003\161\003\161\003\161\003\161\003\161\003\161\004A\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\000\238\t2\tb\001\234\003\161\003\161\004A\004A\007\002\007B\003\161\003\161\003\161\003\161\003\161\001\222\003\161\003\161\003\161\003\161\t:\004A\tj\003\161\004V\003\161\003\161\016Z\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\006\237\003\161\003\161\003\161\003\161\003\161\t\217\t\217\018\178\007n\b\n\t\217\006\130\t\217\t\217\001\238\t\217\t\217\t\217\t\217\000\238\t\217\t\217\006\149\t\217\t\217\t\217\000\238\t\217\t\217\t\217\t\217\004A\t\217\007\194\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\006\149\007\002\018\186\t\217\000\238\t\217\t\217\t\217\t\217\t\217\005\217\t\217\t\217\001\206\t\217\012f\t\217\t\217\t\217\015\022\016v\t\217\t\217\t\217\t\217\t\217\t\217\t\217\000\238\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\0262\t\217\t\217\007n\t\217\t\217\003\130\003N\t\162\004A\t\217\t\217\t\217\t\217\t\217\002Z\t\217\t\217\t\217\t\217\t\217\000\238\t\217\t\217\004&\t\217\t\217\003R\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\000\238\004A\t\217\t\217\t\217\t\217\t\209\t\209\004\214\001f\003i\t\209\n\134\t\209\t\209\025\018\t\209\t\209\t\209\t\209\003\134\t\209\t\209\004:\t\209\t\209\t\209\003\137\t\209\t\209\t\209\t\209\b\241\t\209\004B\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\007\194\0266\015\134\t\209\001\206\t\209\t\209\t\209\t\209\t\209\005\209\t\209\t\209\000\238\t\209\012~\t\209\t\209\t\209\022f\011\022\t\209\t\209\t\209\t\209\t\209\t\209\t\209\000\238\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\011\026\t\209\t\209\022n\t\209\t\209\002\186\004\146\007\002\b\241\t\209\t\209\t\209\t\209\t\209\007\005\t\209\t\209\t\209\t\209\t\209\025\022\t\209\t\209\b\021\t\209\t\209\025\"\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\000\238\b\241\t\209\t\209\t\209\t\209\t\225\t\225\b\193\007n\007\194\t\225\011\234\t\225\t\225\007\182\t\225\t\225\t\225\t\225\006\214\t\225\t\225\000\238\t\225\t\225\t\225\000\238\t\225\t\225\t\225\t\225\005*\t\225\011\238\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\001\007\002\006\182\t\225\000\238\t\225\t\225\t\225\t\225\t\225\021\218\t\225\t\225\004&\t\225\012\146\t\225\t\225\t\225\014\226\026\198\t\225\t\225\t\225\t\225\t\225\t\225\t\225\bj\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\004\230\t\225\t\225\007n\t\225\t\225\005\018\021\226\b\193\005.\t\225\t\225\t\225\t\225\t\225\005\209\t\225\t\225\t\225\t\225\t\225\000\238\t\225\t\225\007~\t\225\t\225\002\250\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\t\001\004\186\t\225\t\225\t\225\t\225\t\193\t\193\003j\003n\006\214\t\193\tv\t\193\t\193\005\254\t\193\t\193\t\193\t\193\002\162\t\193\t\193\016\190\t\193\t\193\t\193\017v\t\193\t\193\t\193\t\193\tz\t\193\011>\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\006*\006\142\006\166\t\193\002\250\t\193\t\193\t\193\t\193\t\193\018\026\t\193\t\193\004:\t\193\012\178\t\193\t\193\t\193\002\238\012\018\t\193\t\193\t\193\t\193\t\193\t\193\t\193\018&\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\012\022\t\193\t\193\b\189\t\193\t\193\002\254\012^\001\002\001\190\t\193\t\193\t\193\t\193\t\193\004F\t\193\t\193\t\193\t\193\t\193\006U\t\193\t\193\011F\t\193\t\193\012b\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\006U\000\238\t\193\t\193\t\193\t\193\t\201\t\201\003j\017\206\002r\t\201\012.\t\201\t\201\006\146\t\201\t\201\t\201\t\201\007\130\t\201\t\201\017\226\t\201\t\201\t\201\tv\t\201\t\201\t\201\t\201\001v\t\201\0122\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\011\174\025\222\b\189\t\201\012\174\t\201\t\201\t\201\t\201\t\201\000\238\t\201\t\201\002r\t\201\012\198\t\201\t\201\t\201\001\222\003\242\t\201\t\201\t\201\t\201\t\201\t\201\t\201\004A\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\0112\t\201\t\201\003\246\t\201\t\201\006\174\016*\001\002\001\190\t\201\t\201\t\201\t\201\t\201\015n\t\201\t\201\t\201\t\201\t\201\006]\t\201\t\201\004\213\t\201\t\201\012>\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\006]\000\238\t\201\t\201\t\201\t\201\n\001\n\001\012\230\012B\002\246\n\001\012v\n\001\n\001\000\238\n\001\n\001\n\001\n\001\n\246\n\001\n\001\000\238\n\001\n\001\n\001\012\018\n\001\n\001\n\001\n\001\001\134\n\001\012z\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\004\182\006\162\011N\n\001\012\242\n\001\n\001\n\001\n\001\n\001\011r\n\001\n\001\019\"\n\001\012\218\n\001\n\001\n\001\006\226\012^\n\001\n\001\n\001\n\001\n\001\n\001\n\001\021\186\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\rJ\n\001\n\001\n\178\n\001\n\001\n\190\014\022\007\130\022\002\n\001\n\001\n\001\n\001\n\001\018\162\n\001\n\001\n\001\n\001\n\001\006e\n\001\n\001\n\178\n\001\n\001\n\190\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\006e\011\234\n\001\n\001\n\001\n\001\t\241\t\241\027*\001\222\014\030\t\241\004\186\t\241\t\241\000\238\t\241\t\241\t\241\t\241\001\206\t\241\t\241\012\194\t\241\t\241\t\241\0142\t\241\t\241\t\241\t\241\001\150\t\241\012.\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\005\n\018\190\014F\t\241\0146\t\241\t\241\t\241\t\241\t\241\014j\t\241\t\241\r\006\t\241\012\246\t\241\t\241\t\241\002~\005\026\t\241\t\241\t\241\t\241\t\241\t\241\t\241\004A\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\b\217\t\241\t\241\rj\t\241\t\241\005\221\018\182\002\162\026\026\t\241\t\241\t\241\t\241\t\241\005\225\t\241\t\241\t\241\t\241\t\241\b\230\t\241\t\241\t\006\t\241\t\241\tN\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\000\238\000\238\t\241\t\241\t\241\t\241\t\233\t\233\001\002\001\190\014n\t\233\b\237\t\233\t\233\019:\t\233\t\233\t\233\t\233\017\214\t\233\t\233\012v\t\233\t\233\t\233\001\206\t\233\t\233\t\233\t\233\004\186\t\233\014J\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\005\"\b\217\rV\t\233\rn\t\233\t\233\t\233\t\233\t\233\014\198\t\233\t\233\022\250\t\233\r\n\t\233\t\233\t\233\000\238\012>\t\233\t\233\t\233\t\233\t\233\t\233\t\233\023\146\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\002\250\t\233\t\233\r\026\t\233\t\233\018\234\014\242\023\150\017B\t\233\t\233\t\233\t\233\t\233\019B\t\233\t\233\t\233\t\233\t\233\011>\t\233\t\233\tV\t\233\t\233\014Z\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\001\002\001\190\t\233\t\233\t\233\t\233\t\249\t\249\014^\014\162\b!\t\249\004\186\t\249\t\249\000\238\t\249\t\249\t\249\t\249\014\210\t\249\t\249\014\202\t\249\t\249\t\249\tf\t\249\t\249\t\249\t\249\014\166\t\249\014\254\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\014\214\021\230\019\130\t\249\014\246\t\249\t\249\t\249\t\249\t\249\015\154\t\249\t\249\015\002\t\249\r\030\t\249\t\249\t\249\018\226\011>\t\249\t\249\t\249\t\249\t\249\t\249\t\249\026\022\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\b%\t\249\t\249\015\170\t\249\t\249\005\213\003}\002\253\019\150\t\249\t\249\t\249\t\249\t\249\n\158\t\249\t\249\t\249\t\249\t\249\018z\t\249\t\249\n\214\t\249\t\249\019.\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\019f\n\250\t\249\t\249\t\249\t\249\nI\nI\007\241\007R\011*\nI\018\254\nI\nI\023\018\nI\nI\nI\nI\023\006\nI\nI\007R\nI\nI\nI\011Z\nI\nI\nI\nI\026&\nI\024\246\nI\nI\nI\nI\nI\nI\nI\nI\007R\022r\021\222\nI\000\238\nI\nI\nI\nI\nI\r\005\nI\nI\000\238\nI\r*\nI\nI\nI\019\154\012\142\nI\nI\nI\nI\nI\nI\nI\022\"\nI\nI\nI\nI\nI\nI\nI\nI\nI\nI\nI\022j\nI\nI\022B\nI\nI\b\025\001\206\023.\b\021\nI\nI\nI\nI\nI\019B\nI\nI\nI\nI\nI\r\017\nI\nI\004&\nI\nI\023f\nI\nI\nI\nI\nI\nI\nI\nI\nI\nI\nI\nI\nI\000\238\001\206\nI\nI\nI\nI\003\157\003\157\025\170\007R\023\210\003\157\n\134\003\157\003\157\000\238\003\157\003\157\003\157\003\157\rb\003\157\003\157\024\250\003\157\003\157\003\157\rz\003\157\003\157\003\157\003\157\027o\003\157\027&\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\026\142\r\130\022\162\003\157\002\006\003\157\003\157\003\157\003\157\003\157\024\178\003\157\003\157\004Y\003\157\r\150\003\157\003\157\003\157\024\230\r\198\003\157\003\157\003\157\003\157\003\157\003\157\003\157\r\242\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\024\218\t2\tb\026\186\003\157\003\157\001\222\015J\015r\003\226\003\157\003\157\003\157\003\157\003\157\002\198\003\157\003\157\003\157\003\157\t:\023\214\tj\003\157\015\142\003\157\003\157\015\146\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\000\238\003\157\003\157\003\157\003\157\003\157\001\237\001\237\015\186\015\206\015\230\001\237\015\250\002\162\001\237\016&\002f\001\237\tJ\001\237\016:\002\218\001\237\024\182\001\237\001\237\001\237\017:\001\237\001\237\001\237\001\210\024\234\tR\017F\002\222\001\237\001\237\001\237\001\237\001\237\tZ\001\237\005\250\017\234\018\002\002\226\018\138\001\237\001\237\001\237\001\237\001\237\018\142\003\022\001\190\026\190\001\237\018\198\001\237\001\237\002\150\018\202\018\242\003\030\001\237\001\237\001\237\007\254\b\002\b\014\018\246\012J\005Z\001\237\001\237\001\237\001\237\001\237\001\237\001\237\001\237\001\237\019\030\t2\tb\019\202\001\237\001\237\019\206\019\242\019\246\020\006\005f\005j\001\237\001\237\001\237\020\022\001\237\001\237\001\237\001\237\012R\020\"\012\162\001\237\020V\001\237\001\237\020Z\001\237\001\237\001\237\001\237\001\237\001\237\005n\b\022\001\237\001\237\001\237\b.\004V\020\166\020\206\001\237\001\237\001\237\001\237\n1\n1\020\210\020\226\0212\n1\021R\002\162\n1\021\146\002f\n1\n1\n1\021\182\002\218\n1\021\198\n1\n1\n1\021\238\n1\n1\n1\001\210\021\242\n1\021\254\002\222\n1\n1\n1\n1\n1\n1\n1\022\014\022*\022:\002\226\022N\n1\n1\n1\n1\n1\022z\003\022\001\190\022~\n1\022\138\n1\n1\002\150\022\154\022\174\003\030\n1\n1\n1\007\254\b\002\b\014\023\162\n1\005Z\n1\n1\n1\n1\n1\n1\n1\n1\n1\023\250\n1\n1\024\"\n1\n1\024\138\024\154\0256\025>\005f\005j\n1\n1\n1\025N\n1\n1\n1\n1\n1\025Z\n1\n1\025\190\n1\n1\025\210\n1\n1\n1\n1\n1\n1\005n\b\022\n1\n1\n1\b.\004V\026\002\026\n\n1\n1\n1\n1\n-\n-\026F\026n\026\166\n-\026\214\002\162\n-\026\226\002f\n-\n-\n-\026\234\002\218\n-\026\243\n-\n-\n-\027\003\n-\n-\n-\001\210\027\022\n-\0272\002\222\n-\n-\n-\n-\n-\n-\n-\027O\027_\027{\002\226\027\175\n-\n-\n-\n-\n-\027\203\003\022\001\190\027\214\n-\028\011\n-\n-\002\150\028\031\028'\003\030\n-\n-\n-\007\254\b\002\b\014\028c\n-\005Z\n-\n-\n-\n-\n-\n-\n-\n-\n-\028k\n-\n-\000\000\n-\n-\000\000\000\000\000\000\000\000\005f\005j\n-\n-\n-\000\000\n-\n-\n-\n-\n-\000\000\n-\n-\000\000\n-\n-\000\000\n-\n-\n-\n-\n-\n-\005n\b\022\n-\n-\n-\b.\004V\000\000\000\000\n-\n-\n-\n-\0029\0029\000\000\000\000\000\000\0029\000\000\002\162\0029\000\000\002f\0029\tJ\0029\000\000\002\218\0029\000\000\0029\0029\0029\000\000\0029\0029\0029\001\210\002\225\tR\000\000\002\222\0029\0029\0029\0029\0029\tZ\0029\000\000\000\000\000\000\002\226\004A\0029\0029\0029\0029\0029\000\000\003\022\001\190\000\000\0029\000\n\0029\0029\002\150\000\000\000\000\003\030\0029\0029\0029\007\254\b\002\b\014\000\000\012J\005Z\0029\0029\0029\0029\0029\0029\0029\0029\0029\000\000\004\173\0029\002\225\0029\0029\004A\006f\002\162\004A\005f\005j\0029\0029\0029\000\000\0029\0029\0029\0029\000\000\000\238\004A\0029\004\173\0029\0029\004A\0029\0029\0029\0029\0029\0029\005n\b\022\0029\0029\0029\b.\004V\000\000\004A\0029\0029\0029\0029\004A\004A\004A\002\238\004A\004A\004A\004A\004A\004A\004A\017\158\004A\000\238\004A\004A\000\000\004A\004A\004A\000\000\004A\004A\004A\004A\004A\004A\004A\004A\004A\000\238\004A\004A\000\000\000\000\004A\004A\000\238\004A\004A\004A\004A\004A\000\238\004A\004A\004A\004A\004A\004A\004A\004A\000\238\004A\004A\004A\004A\004A\004A\004A\004A\000\238\004A\004A\004A\004A\004A\004A\004A\004A\b\189\0042\004A\000\000\000\000\004A\004A\004A\000\238\004A\000\n\000\000\004A\004A\004A\004A\004A\004A\004A\004A\004A\000\000\021\170\004A\004A\002\225\002\225\007J\004A\004&\006\233\000\000\004A\004A\000\000\007R\000\000\022\026\002\225\000\238\004A\004A\004A\007V\000\000\004A\004A\004A\004A\006\233\000\161\004A\000\161\006\233\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\000\000\161\022\206\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\0046\000\161\000\161\b\189\000\000\000\161\000\161\005\141\000\161\000\161\000\161\000\238\000\161\b\241\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\000\bn\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\233\000\000\015f\t\029\000\161\002f\000\161\001\210\000\161\005\141\002\162\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~\017\210\t\029\005\141\000\222\000\000\006\230\001\222\000\161\000\000\002\198\000\000\014z\002\150\000\161\000\161\000\161\000\161\000\000\015j\000\161\000\161\000\161\000\161\002)\002)\004Y\000\000\002\238\002)\000\000\002\162\002)\015v\002f\002)\001b\002)\000\000\002\218\002)\006\234\002)\002)\002)\000\000\002)\002)\002)\001\210\001z\000\000\001\138\002\222\002)\002)\002)\002)\002)\005j\002)\000\000\000\000\000\000\002\226\b\169\002)\002)\002)\002)\002)\004Y\003\022\b\018\000\000\002)\000\000\002)\002)\002\150\000\000\006\006\003\030\002)\002)\002)\007\254\b\002\b\014\t2\tb\005Z\002)\002)\002)\002)\002)\002)\002)\002)\002)\006\n\t2\tb\b\169\002)\002)\000\000\t:\007\002\tj\005f\005j\002)\002)\002)\000\000\002)\002)\002)\002)\t:\000\000\tj\002)\b\169\002)\002)\016j\002)\002)\002)\002)\002)\002)\005n\b\022\002)\002)\002)\b.\004V\000\238\000\000\002)\002)\002)\002)\002E\002E\000\000\007n\000\000\002E\000\000\000\000\002E\000\000\b\169\002E\000\000\002E\004\226\000\000\002E\b\169\002E\002E\002E\000\238\002E\002E\002E\000\000\027\187\000\000\002\225\002\225\002E\002E\002E\002E\002E\000\000\002E\000\000\006\014\004\169\000\000\005\206\002E\002E\002E\002E\002E\000\000\006\026\000\000\000\000\002E\006&\002E\002E\000\n\000\000\000\000\006b\002E\002E\002E\004\169\000\000\000\000\006\213\016n\000\000\002E\002E\002E\002E\002E\002E\002E\002E\002E\000\000\t2\tb\000\000\002E\002E\002\225\006j\000\000\002\162\000\000\006\213\002E\002E\002E\000\000\002E\002E\002E\002E\t:\002\162\tj\002E\002f\002E\002E\001\210\002E\002E\002E\002E\002E\002E\b\165\000\000\002E\002E\002E\000\000\021\154\000\000\000\000\002E\002E\002E\002E\002A\002A\000\000\022\214\002\238\002A\022\218\002\250\002A\000\000\002\150\002A\000\000\002A\000\000\017j\002A\023\n\002A\002A\002A\t>\002A\002A\002A\012\n\b\165\000\000\000\000\015v\002A\002A\002A\002A\002A\rN\002A\rZ\000\000\012&\023\026\0126\002A\002A\002A\002A\002A\b\165\bJ\001\190\001*\002A\000\000\002A\002A\005j\002\225\002\225\014:\002A\002A\002A\014N\014b\014r\000\000\000\000\000\000\002A\002A\002A\002A\002A\002A\002A\002A\002A\000\000\t2\tb\b\165\002A\002A\000\n\004\226\000\000\001\206\b\165\000\000\002A\002A\002A\000\000\002A\002A\002A\002A\t:\000\000\tj\002A\000\000\002A\002A\001\210\002A\002A\002A\002A\002A\002A\002\225\000\000\002A\002A\002A\000\000\018\146\000\000\000\000\002A\002A\002A\002A\002-\002-\000\000\000\000\002~\002-\019\026\002\250\002-\000\000\002\150\002-\000\000\002-\000\000\000\000\002-\0192\002-\002-\002-\012V\002-\002-\002-\002\225\002\225\016\150\000\000\000\000\002-\002-\002-\002-\002-\012n\002-\012\134\000\000\000\000\002\225\012\234\002-\002-\002-\002-\002-\000\000\bJ\014\178\000\000\002-\000\n\002-\002-\012\254\000\000\r\018\014:\002-\002-\002-\014N\014b\014r\t\025\000\000\000\000\002-\002-\002-\002-\002-\002-\002-\002-\002-\000\000\t2\tb\002\225\002-\002-\000\000\014\146\002\225\000\000\000\238\t\025\002-\002-\002-\000\000\002-\002-\002-\002-\t:\000\000\tj\002-\000\000\002-\002-\000\000\002-\002-\002-\002-\002-\002-\000\n\000\000\002-\002-\002-\000\000\t\030\000\000\000\000\002-\002-\002-\002-\002=\002=\000\000\002\225\000\000\002=\012}\006\014\002=\000\000\005\206\002=\000\000\002=\000\000\002\225\002=\006\026\002=\002=\002=\006&\002=\002=\002=\012}\012}\000\000\000\000\012}\002=\002=\002=\002=\002=\000\000\002=\b\021\000\000\000\000\b\021\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\"\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\021\002=\000\000\002=\002=\000\000\000\000\000\000\000\000\000\000\000\000\002=\002=\002=\b\021\002=\002=\002=\002=\012}\000\000\004\253\002=\000\000\002=\002=\002\225\t\130\002=\002=\002=\002=\002=\004\253\n\202\002=\002=\002=\000\000\000\000\b\021\000\000\002=\002=\002=\002=\t%\t%\000\000\000\000\000\000\t%\000\000\000\000\t%\000\n\000\000\t%\000\000\t%\000\000\000\000\t\174\004\253\t%\t\210\t%\b\021\t%\t%\t%\002\225\000\000\000\000\000\000\017\006\t\230\t\254\n\006\t\238\n\014\000\000\t%\002\225\002\225\000\000\000\000\000\000\t%\t%\n\022\n\030\t%\004\253\007\245\000\000\004\253\t%\000\000\n&\t%\000\000\000\000\000\000\000\000\t%\t%\000\238\000\000\000\000\000\000\000\000\000\000\002\218\t%\t%\t\182\t\246\n.\n6\nF\t%\t%\002\138\012\181\t%\000\000\t%\nN\000\000\003>\000\000\000\000\000\238\000\000\t%\t%\nV\000\000\t%\t%\t%\t%\003J\012\181\000\000\t%\000\000\t%\t%\002\030\nv\t%\n~\n>\t%\t%\000\000\000\000\t%\n^\t%\000\000\002&\000\000\005Z\t%\t%\nf\nn\002q\002q\000\000\000\000\000\000\002q\012\133\006\014\002q\000\000\005\206\002q\000\000\002q\000\000\005f\002q\006\026\002q\002q\002q\006&\002q\002q\002q\012\133\012\133\000\000\000\000\012\133\002q\002q\002q\002q\002q\000\000\002q\015f\000\000\005n\002f\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\t\182\002q\002q\002q\002q\002q\002q\000\000\015j\002q\000\000\002q\002q\000\000\000\000\000\000\000\000\000\000\000\000\002q\002q\002q\015v\002q\002q\002q\002q\012\133\000\000\001\206\002q\000\000\002q\002q\000\000\002q\002q\002q\002q\002q\002q\025\242\000\000\002q\002q\002q\000\000\000\000\005j\000\000\002q\002q\002q\002q\002Y\002Y\000\000\000\000\000\000\002Y\000\000\002\162\002Y\000\000\000\000\002Y\000\000\002Y\003\142\000\000\002Y\002~\002Y\002Y\002Y\025b\002Y\002Y\002Y\001\210\000\000\000\000\000\000\000\000\002Y\002Y\002Y\002Y\002Y\000\000\002Y\015f\000\000\000\000\002f\000\000\002Y\002Y\002Y\002Y\002Y\004~\003\174\000\000\004\217\002Y\000\000\002Y\002Y\002\150\000\000\000\000\000\000\002Y\002Y\002Y\000\000\000\000\000\000\000\000\000\000\000\000\002Y\002Y\t\182\002Y\002Y\002Y\002Y\002Y\002Y\000\000\015j\002Y\000\000\002Y\002Y\006\206\000\000\000\000\000\000\000\000\000\000\002Y\002Y\002Y\015v\002Y\002Y\002Y\002Y\000\000\000\000\000\000\002Y\000\000\002Y\002Y\000\000\002Y\002Y\002Y\002Y\002Y\002Y\012\129\000\000\002Y\002Y\002Y\000\000\000\000\005j\000\000\002Y\002Y\002Y\002Y\002e\002e\000\000\000\000\000\000\002e\012\129\012\129\002e\000\000\012\129\002e\000\000\002e\000\000\000\000\t\174\000\000\002e\002e\002e\020\254\002e\002e\002e\000\000\000\000\000\000\000\000\000\000\002e\002e\002e\t\238\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\t\182\t\246\002e\002e\002e\002e\002e\000\000\012\129\002e\000\000\002e\002e\000\000\000\000\000\000\000\000\000\238\b\t\002e\002e\002e\b\t\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~\000\000\000\000\002e\002e\002e\002e\002u\002u\000\000\000\000\000\000\002u\b\t\011\134\002u\000\000\011\146\002u\000\000\002u\000\000\000\000\002u\011\158\002u\002u\002u\011\170\002u\002u\002u\000\000\000\000\b\t\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\226\000\000\000\000\000\000\002u\002u\t\182\002u\002u\002u\002u\002u\002u\000\000\007\206\002u\000\000\002u\002u\000\000\000\000\000\000\000\000\000\238\b\005\002u\002u\002u\b\005\002u\002u\002u\002u\000\000\007\210\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\165\000\000\000\000\002u\002u\002u\002u\002U\002U\007\194\000\000\000\000\002U\b\005\007\165\002U\000\000\005\206\002U\000\000\002U\000\000\000\238\002U\007\165\002U\002U\002U\007\165\002U\002U\002U\000\000\000\000\b\005\000\000\000\000\002U\002U\002U\002U\002U\000\000\002U\000\000\000\000\006\253\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\006\253\002U\002U\002U\006\253\007\214\004\226\000\000\000\000\000\000\002U\002U\t\182\002U\002U\002U\002U\002U\002U\000\000\000\000\002U\000\000\002U\002U\000\000\000\000\000\000\000\000\007\189\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\189\000\000\000\000\002U\002U\002U\002U\002a\002a\000\000\000\000\000\000\002a\005J\007\189\002a\000\000\005\206\002a\000\000\002a\000\000\000\000\t\174\007\189\002a\002a\002a\007\189\002a\002a\002a\000\000\000\000\000\000\000\000\000\000\002a\002a\002a\t\238\002a\000\000\002a\000\000\000\000\006\237\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\237\002a\002a\002a\006\237\000\000\000\000\000\000\000\000\000\000\002a\002a\t\182\t\246\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\217\000\000\000\000\002a\002a\002a\002a\002]\002]\000\000\000\000\000\000\002]\b\n\006\014\002]\000\000\005\206\002]\000\000\002]\000\000\000\000\t\174\007\217\002]\002]\002]\007\217\002]\002]\002]\000\000\000\000\000\000\000\000\000\000\002]\002]\002]\t\238\002]\000\000\002]\000\000\000\000\000\000\000\000\000\000\002]\002]\002]\002]\002]\000\000\000\000\000\000\000\000\002]\000\000\002]\002]\000\000\000\000\000\000\000\000\002]\002]\002]\000\000\000\000\000\000\000\000\000\000\000\000\002]\002]\t\182\t\246\002]\002]\002]\002]\002]\000\000\000\000\002]\000\000\002]\002]\000\000\000\000\000\000\000\000\007\209\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\209\000\000\000\000\002]\002]\002]\002]\002\133\002\133\000\000\000\000\000\000\002\133\000\000\011\194\002\133\000\000\007\209\002\133\000\000\002\133\000\000\000\000\t\174\007\209\002\133\002\133\002\133\007\209\002\133\002\133\002\133\000\000\000\000\000\000\000\000\000\000\t\230\t\254\n\006\t\238\n\014\000\000\002\133\000\000\000\000\000\000\000\000\000\000\002\133\002\133\n\022\n\030\002\133\000\000\000\000\000\000\000\000\002\133\000\000\n&\002\133\000\000\000\000\000\000\000\000\002\133\002\133\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\133\002\133\t\182\t\246\n.\n6\nF\002\133\002\133\000\000\000\000\002\133\000\000\002\133\nN\000\000\000\000\000\000\000\000\000\238\000\000\002\133\002\133\nV\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>\002\133\002\133\000\000\000\000\002\133\n^\002\133\000\000\007\161\000\000\000\000\002\133\002\133\nf\nn\002m\002m\000\000\000\000\000\000\002m\000\000\007\161\002m\000\000\005\206\002m\000\000\002m\000\000\000\000\t\174\007\161\002m\002m\002m\007\161\002m\002m\002m\000\000\000\000\000\000\000\000\000\000\002m\002m\002m\t\238\002m\000\000\002m\000\000\000\000\000\000\000\000\000\000\002m\002m\002m\002m\002m\000\000\000\000\000\000\000\000\002m\000\000\002m\002m\000\000\000\000\000\000\000\000\002m\002m\002m\000\000\000\000\000\000\000\000\000\000\000\000\002m\002m\t\182\t\246\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\014\n\000\000\000\000\002m\002m\002m\002m\002i\002i\000\000\000\000\000\000\002i\000\000\011\134\002i\000\000\011\146\002i\000\000\002i\000\000\000\000\t\174\011\158\002i\002i\002i\011\170\002i\002i\002i\000\000\000\000\000\000\000\000\000\000\002i\002i\002i\t\238\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\t\182\t\246\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\002f\002}\000\000\002}\000\000\000\000\t\174\000\000\002}\002}\002}\000\000\002}\002}\002}\000\000\000\000\000\000\000\000\000\000\t\230\t\254\n\006\t\238\002}\000\000\002}\000\000\000\000\000\000\000\000\000\000\002}\002}\n\022\n\030\002}\000\000\027\014\001\222\000\000\002}\000\000\002}\002}\000\000\000\000\000\000\000\000\002}\002}\000\238\015v\000\000\000\000\000\000\000\000\000\000\002}\002}\t\182\t\246\n.\n6\002}\002}\002}\000\000\000\000\002}\000\000\002}\002}\000\000\000\000\000\000\000\000\000\000\005j\002}\002}\002}\000\000\002}\002}\002}\002}\000\000\000\000\000\000\002}\000\000\002}\002}\000\000\002}\002}\002}\n>\002}\002}\000\000\000\000\002}\002}\002}\000\000\000\000\000\000\000\000\002}\002}\002}\002}\002Q\002Q\000\000\000\000\000\000\002Q\000\000\002\250\002Q\000\000\000\000\002Q\000\000\002Q\000\000\000\000\t\174\000\000\002Q\002Q\002Q\000\000\002Q\002Q\002Q\000\000\000\000\000\000\000\000\000\000\002Q\002Q\002Q\t\238\002Q\000\000\002Q\000\000\000\000\000\000\000\000\000\000\002Q\002Q\002Q\002Q\002Q\000\000\005\162\000\000\000\000\002Q\000\000\002Q\002Q\000\000\000\000\000\000\003\218\002Q\002Q\002Q\0062\000\000\003\230\000\000\000\000\000\000\002Q\002Q\t\182\t\246\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\162\002M\000\000\000\000\002M\000\000\002M\000\000\000\000\t\174\000\000\002M\002M\002M\000\000\002M\002M\002M\000\000\000\000\000\000\000\000\000\000\t\230\t\254\n\006\t\238\002M\000\000\002M\000\000\000\000\000\000\000\000\000\000\002M\002M\n\022\n\030\002M\000\000\tn\002\238\000\000\002M\000\000\002M\002M\000\000\000\000\000\000\000\000\002M\002M\000\238\011\226\000\000\011\242\000\000\000\000\000\000\002M\002M\t\182\t\246\n.\n6\002M\002M\002M\000\000\000\000\002M\000\000\002M\002M\000\000\000\000\000\000\000\000\000\000\000\000\002M\002M\002M\000\000\002M\002M\002M\002M\000\000\000\000\000\000\002M\000\000\002M\002M\000\000\002M\002M\002M\n>\002M\002M\000\000\000\000\002M\002M\002M\000\000\000\000\000\000\000\000\002M\002M\002M\002M\002\169\002\169\000\000\000\000\000\000\002\169\000\000\002\162\002\169\000\000\000\000\002\169\000\000\002\169\000\000\000\000\t\174\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\t\230\t\254\n\006\t\238\002\169\000\000\002\169\000\000\000\000\000\000\000\000\000\000\002\169\002\169\n\022\n\030\002\169\000\000\012\166\002\238\000\000\002\169\000\000\002\169\002\169\000\000\000\000\000\000\000\000\002\169\002\169\002\169\012\186\000\000\012\206\000\000\000\000\000\000\002\169\002\169\t\182\t\246\n.\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>\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\t\174\000\000\002I\002I\002I\000\000\002I\002I\002I\000\000\000\000\000\000\000\000\000\000\t\230\t\254\n\006\t\238\002I\000\000\002I\000\000\000\000\000\000\000\000\000\000\002I\002I\n\022\n\030\002I\000\000\000\000\000\000\000\000\002I\000\000\002I\002I\000\000\000\000\000\000\000\000\002I\002I\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002I\002I\t\182\t\246\n.\n6\002I\002I\002I\000\000\000\000\002I\000\000\002I\002I\000\000\000\000\000\000\000\000\000\000\000\000\002I\002I\002I\000\000\002I\002I\002I\002I\000\000\000\000\000\000\002I\000\000\002I\002I\000\000\002I\002I\002I\n>\002I\002I\000\000\000\000\002I\002I\002I\000\000\000\000\000\000\000\000\002I\002I\002I\002I\002\129\002\129\000\000\000\000\000\000\002\129\000\000\000\000\002\129\000\000\000\000\002\129\000\000\002\129\000\000\000\000\t\174\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\t\230\t\254\n\006\t\238\002\129\000\000\002\129\000\000\000\000\000\000\000\000\000\000\002\129\002\129\n\022\n\030\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\t\182\t\246\n.\n6\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>\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\t\174\000\000\002y\002y\002y\000\000\002y\002y\002y\000\000\000\000\000\000\000\000\000\000\t\230\t\254\n\006\t\238\002y\000\000\002y\000\000\000\000\000\000\000\000\000\000\002y\002y\n\022\n\030\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\t\182\t\246\n.\n6\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>\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\t\174\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\t\230\t\254\n\006\t\238\n\014\000\000\002\137\000\000\000\000\000\000\000\000\000\000\002\137\002\137\n\022\n\030\002\137\000\000\000\000\000\000\000\000\002\137\000\000\n&\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\t\182\t\246\n.\n6\nF\002\137\002\137\000\000\000\000\002\137\000\000\002\137\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\137\002\137\nV\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>\002\137\002\137\000\000\000\000\002\137\n^\002\137\000\000\000\000\000\000\000\000\002\137\002\137\nf\nn\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\t\174\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\t\230\t\254\n\006\t\238\002\141\000\000\002\141\000\000\000\000\000\000\000\000\000\000\002\141\002\141\n\022\n\030\002\141\000\000\000\000\000\000\000\000\002\141\000\000\n&\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\t\182\t\246\n.\n6\nF\002\141\002\141\000\000\000\000\002\141\000\000\002\141\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\141\002\141\nV\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>\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\nf\nn\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\t\174\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\t\230\t\254\n\006\t\238\002\145\000\000\002\145\000\000\000\000\000\000\000\000\000\000\002\145\002\145\n\022\n\030\002\145\000\000\000\000\000\000\000\000\002\145\000\000\n&\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\t\182\t\246\n.\n6\nF\002\145\002\145\000\000\000\000\002\145\000\000\002\145\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\145\002\145\nV\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>\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\nf\nn\b\225\b\225\000\000\000\000\000\000\b\225\000\000\000\000\b\225\000\000\000\000\b\225\000\000\b\225\000\000\000\000\t\174\000\000\b\225\b\225\b\225\000\000\b\225\b\225\b\225\000\000\000\000\000\000\000\000\000\000\t\230\t\254\n\006\t\238\n\014\000\000\b\225\000\000\000\000\000\000\000\000\000\000\b\225\b\225\n\022\n\030\b\225\000\000\000\000\000\000\000\000\b\225\000\000\n&\b\225\000\000\000\000\000\000\000\000\b\225\b\225\000\238\000\000\000\000\000\000\000\000\000\000\000\000\b\225\b\225\t\182\t\246\n.\n6\nF\b\225\b\225\000\000\000\000\b\225\000\000\b\225\nN\000\000\000\000\000\000\000\000\000\000\000\000\b\225\b\225\nV\000\000\b\225\b\225\b\225\b\225\000\000\000\000\000\000\b\225\000\000\b\225\b\225\000\000\b\225\b\225\b\225\n>\b\225\b\225\000\000\000\000\b\225\n^\b\225\000\000\000\000\000\000\000\000\b\225\b\225\nf\nn\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\t\174\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\t\230\t\254\n\006\t\238\n\014\000\000\002\149\000\000\000\000\000\000\000\000\000\000\002\149\002\149\n\022\n\030\002\149\000\000\000\000\000\000\000\000\002\149\000\000\n&\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\t\182\t\246\n.\n6\nF\002\149\002\149\000\000\000\000\002\149\000\000\002\149\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\149\002\149\nV\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\nv\002\149\n~\n>\002\149\002\149\000\000\000\000\002\149\n^\002\149\000\000\000\000\000\000\000\000\002\149\002\149\nf\nn\b\221\b\221\000\000\000\000\000\000\b\221\000\000\000\000\b\221\000\000\000\000\b\221\000\000\b\221\000\000\000\000\t\174\000\000\b\221\b\221\b\221\000\000\b\221\b\221\b\221\000\000\000\000\000\000\000\000\000\000\t\230\t\254\n\006\t\238\n\014\000\000\b\221\000\000\000\000\000\000\000\000\000\000\b\221\b\221\n\022\n\030\b\221\000\000\000\000\000\000\000\000\b\221\000\000\n&\b\221\000\000\000\000\000\000\000\000\b\221\b\221\000\238\000\000\000\000\000\000\000\000\000\000\000\000\b\221\b\221\t\182\t\246\n.\n6\nF\b\221\b\221\000\000\000\000\b\221\000\000\b\221\nN\000\000\000\000\000\000\000\000\000\000\000\000\b\221\b\221\nV\000\000\b\221\b\221\b\221\b\221\000\000\000\000\000\000\b\221\000\000\b\221\b\221\000\000\b\221\b\221\b\221\n>\b\221\b\221\000\000\000\000\b\221\n^\b\221\000\000\000\000\000\000\000\000\b\221\b\221\nf\nn\002\197\002\197\000\000\000\000\000\000\002\197\000\000\000\000\002\197\000\000\000\000\002\197\000\000\002\197\000\000\000\000\t\174\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\t\230\t\254\n\006\t\238\n\014\000\000\002\197\000\000\000\000\000\000\000\000\000\000\002\197\002\197\n\022\n\030\002\197\000\000\000\000\000\000\000\000\002\197\000\000\n&\002\197\000\000\000\000\000\000\000\000\002\197\002\197\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\197\002\197\t\182\t\246\n.\n6\nF\002\197\002\197\000\000\000\000\002\197\000\000\002\197\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\197\002\197\nV\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\nv\002\197\n~\n>\002\197\002\197\000\000\000\000\002\197\n^\002\197\000\000\000\000\000\000\000\000\002\197\002\197\nf\nn\002\193\002\193\000\000\000\000\000\000\002\193\000\000\000\000\002\193\000\000\000\000\002\193\000\000\002\193\000\000\000\000\t\174\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\t\230\t\254\n\006\t\238\n\014\000\000\002\193\000\000\000\000\000\000\000\000\000\000\002\193\002\193\n\022\n\030\002\193\000\000\000\000\000\000\000\000\002\193\000\000\n&\002\193\000\000\000\000\000\000\000\000\002\193\002\193\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\193\002\193\t\182\t\246\n.\n6\nF\002\193\002\193\000\000\000\000\002\193\000\000\002\193\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\193\002\193\nV\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\nv\002\193\n~\n>\002\193\002\193\000\000\000\000\002\193\n^\002\193\000\000\000\000\000\000\000\000\002\193\002\193\nf\nn\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\t\174\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\t\230\t\254\n\006\t\238\n\014\000\000\002\201\000\000\000\000\000\000\000\000\000\000\002\201\002\201\n\022\n\030\002\201\000\000\000\000\000\000\000\000\002\201\000\000\n&\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\t\182\t\246\n.\n6\nF\002\201\002\201\000\000\000\000\002\201\000\000\002\201\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\201\002\201\nV\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\nv\002\201\n~\n>\002\201\002\201\000\000\000\000\002\201\n^\002\201\000\000\000\000\000\000\000\000\002\201\002\201\nf\nn\002\181\002\181\000\000\000\000\000\000\002\181\000\000\000\000\002\181\000\000\000\000\002\181\000\000\002\181\000\000\000\000\t\174\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\t\230\t\254\n\006\t\238\n\014\000\000\002\181\000\000\000\000\000\000\000\000\000\000\002\181\002\181\n\022\n\030\002\181\000\000\000\000\000\000\000\000\002\181\000\000\n&\002\181\000\000\000\000\000\000\000\000\002\181\002\181\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\181\002\181\t\182\t\246\n.\n6\nF\002\181\002\181\000\000\000\000\002\181\000\000\002\181\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\181\002\181\nV\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\nv\002\181\n~\n>\002\181\002\181\000\000\000\000\002\181\n^\002\181\000\000\000\000\000\000\000\000\002\181\002\181\nf\nn\002\185\002\185\000\000\000\000\000\000\002\185\000\000\000\000\002\185\000\000\000\000\002\185\000\000\002\185\000\000\000\000\t\174\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\t\230\t\254\n\006\t\238\n\014\000\000\002\185\000\000\000\000\000\000\000\000\000\000\002\185\002\185\n\022\n\030\002\185\000\000\000\000\000\000\000\000\002\185\000\000\n&\002\185\000\000\000\000\000\000\000\000\002\185\002\185\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\185\002\185\t\182\t\246\n.\n6\nF\002\185\002\185\000\000\000\000\002\185\000\000\002\185\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\185\002\185\nV\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\nv\002\185\n~\n>\002\185\002\185\000\000\000\000\002\185\n^\002\185\000\000\000\000\000\000\000\000\002\185\002\185\nf\nn\002\189\002\189\000\000\000\000\000\000\002\189\000\000\000\000\002\189\000\000\000\000\002\189\000\000\002\189\000\000\000\000\t\174\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\t\230\t\254\n\006\t\238\n\014\000\000\002\189\000\000\000\000\000\000\000\000\000\000\002\189\002\189\n\022\n\030\002\189\000\000\000\000\000\000\000\000\002\189\000\000\n&\002\189\000\000\000\000\000\000\000\000\002\189\002\189\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\189\002\189\t\182\t\246\n.\n6\nF\002\189\002\189\000\000\000\000\002\189\000\000\002\189\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\189\002\189\nV\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\nv\002\189\n~\n>\002\189\002\189\000\000\000\000\002\189\n^\002\189\000\000\000\000\000\000\000\000\002\189\002\189\nf\nn\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\t\174\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\t\230\t\254\n\006\t\238\n\014\000\000\002\209\000\000\000\000\000\000\000\000\000\000\002\209\002\209\n\022\n\030\002\209\000\000\000\000\000\000\000\000\002\209\000\000\n&\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\t\182\t\246\n.\n6\nF\002\209\002\209\000\000\000\000\002\209\000\000\002\209\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\209\002\209\nV\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\nv\002\209\n~\n>\002\209\002\209\000\000\000\000\002\209\n^\002\209\000\000\000\000\000\000\000\000\002\209\002\209\nf\nn\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\t\174\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\t\230\t\254\n\006\t\238\n\014\000\000\002\205\000\000\000\000\000\000\000\000\000\000\002\205\002\205\n\022\n\030\002\205\000\000\000\000\000\000\000\000\002\205\000\000\n&\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\t\182\t\246\n.\n6\nF\002\205\002\205\000\000\000\000\002\205\000\000\002\205\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\205\002\205\nV\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\nv\002\205\n~\n>\002\205\002\205\000\000\000\000\002\205\n^\002\205\000\000\000\000\000\000\000\000\002\205\002\205\nf\nn\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\t\174\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\t\230\t\254\n\006\t\238\n\014\000\000\002\213\000\000\000\000\000\000\000\000\000\000\002\213\002\213\n\022\n\030\002\213\000\000\000\000\000\000\000\000\002\213\000\000\n&\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\t\182\t\246\n.\n6\nF\002\213\002\213\000\000\000\000\002\213\000\000\002\213\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\213\002\213\nV\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\nv\002\213\n~\n>\002\213\002\213\000\000\000\000\002\213\n^\002\213\000\000\000\000\000\000\000\000\002\213\002\213\nf\nn\002\177\002\177\000\000\000\000\000\000\002\177\000\000\000\000\002\177\000\000\000\000\002\177\000\000\002\177\000\000\000\000\t\174\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\t\230\t\254\n\006\t\238\n\014\000\000\002\177\000\000\000\000\000\000\000\000\000\000\002\177\002\177\n\022\n\030\002\177\000\000\000\000\000\000\000\000\002\177\000\000\n&\002\177\000\000\000\000\000\000\000\000\002\177\002\177\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\177\002\177\t\182\t\246\n.\n6\nF\002\177\002\177\000\000\000\000\002\177\000\000\002\177\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\177\002\177\nV\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\nv\002\177\n~\n>\002\177\002\177\000\000\000\000\002\177\n^\002\177\000\000\000\000\000\000\000\000\002\177\002\177\nf\nn\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\r\226\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\t\174\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\t\230\t\254\n\006\t\238\n\014\000\000\002\029\000\000\000\000\000\000\000\000\000\000\002\029\002\029\n\022\n\030\002\029\000\000\000\000\000\000\000\000\002\029\000\000\n&\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\t\182\t\246\n.\n6\nF\002\029\002\029\000\000\000\000\002\029\000\000\002\029\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\029\002\029\nV\000\000\002\029\002\029\r\250\002\029\000\000\000\000\000\000\002\029\000\000\002\029\002\029\000\000\nv\002\029\n~\n>\002\029\002\029\000\000\000\000\002\029\n^\002\029\000\000\000\000\000\000\000\000\002\029\002\029\nf\nn\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\t\174\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\t\230\t\254\n\006\t\238\n\014\000\000\002\025\000\000\000\000\000\000\000\000\000\000\002\025\002\025\n\022\n\030\002\025\000\000\000\000\000\000\000\000\002\025\000\000\n&\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\t\182\t\246\n.\n6\nF\002\025\002\025\000\000\000\000\002\025\000\000\002\025\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\025\002\025\nV\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\nv\002\025\n~\n>\002\025\002\025\000\000\000\000\002\025\n^\002\025\000\000\000\000\000\000\000\000\002\025\002\025\nf\nn\002\173\002\173\000\000\000\000\000\000\002\173\000\000\000\000\002\173\000\000\000\000\002\173\000\000\002\173\000\000\000\000\t\174\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\t\230\t\254\n\006\t\238\n\014\000\000\002\173\000\000\000\000\000\000\000\000\000\000\002\173\002\173\n\022\n\030\002\173\000\000\000\000\000\000\000\000\002\173\000\000\n&\002\173\000\000\000\000\000\000\000\000\002\173\002\173\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\173\002\173\t\182\t\246\n.\n6\nF\002\173\002\173\000\000\000\000\002\173\000\000\002\173\nN\000\000\000\000\000\000\000\000\000\000\000\000\002\173\002\173\nV\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\nv\002\173\n~\n>\002\173\002\173\000\000\000\000\002\173\n^\002\173\000\000\000\000\000\000\000\000\002\173\002\173\nf\nn\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\r\226\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\000\000\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\003\253\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\r\226\000\000\000\000\003\253\000\000\002\017\002\017\002\017\002\017\001\006\000\000\000\006\000\000\007\r\000\000\002\158\002\162\006\014\002\206\002f\005\206\b\214\000\000\000\000\002\218\001\n\012\181\006\026\000\000\002r\000\000\006&\007\r\000\000\001\210\000\000\007\r\000\000\003\026\001\018\bR\bV\001\030\001\"\000\000\000\000\012\181\003*\000\000\002\226\000\000\025\002\002\030\bz\b~\000\000\003\194\003\022\003\206\b\130\006\186\000\000\001:\000\000\002\150\002&\000\000\003\030\002*\012\161\000\000\007\254\b\002\b\014\b\"\000\000\005Z\000\000\000\000\001>\001B\001F\001J\001N\000\000\000\000\b\150\001R\000\000\007\001\000\000\001V\000\000\b\162\b\186\t\014\005f\005j\000\000\000\000\001Z\000\000\000\000\000\000\007\r\000\000\001^\000\000\007\001\000\000\000\000\000\000\007\001\012\181\012\161\000\000\001\154\n\246\000\000\n\178\005n\b\022\n\190\001\158\000\000\014*\004V\t\"\001\006\001\166\000\006\001\170\001\174\012\181\002\158\002\162\000\000\002\206\002f\002\030\000\000\000\000\000\000\002\218\001\n\000\000\002\"\000\000\bN\000\000\000\238\000\000\002&\001\210\000\000\002*\012\161\003\026\001\018\bR\bV\001\030\001\"\000\000\000\000\000\000\003*\000\000\002\226\000\000\bZ\000\000\bz\b~\000\000\003\194\003\022\003\206\b\130\006\186\000\000\001:\000\000\002\150\006\229\000\000\003\030\000\000\000\000\000\000\007\254\b\002\b\014\b\"\006\014\005Z\000\000\005\206\001>\001B\001F\001J\001N\006\229\006\026\b\150\001R\006\229\006&\000\000\001V\000\000\b\162\b\186\t\014\005f\005j\000\000\000\000\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\005\250\000\000\000\000\005n\b\022\000\000\001\158\000\000\014*\004V\t\"\004m\001\166\000\006\001\170\001\174\000\246\002\158\002\162\002\166\002\206\002f\000\000\002\225\000\000\000\000\002\218\018f\000\000\003\150\000\000\000\000\000\000\004m\000\000\003\154\001\210\000\000\016\254\006\229\002\222\000\000\003\"\003&\000\000\000\000\000\000\003\158\000\000\003*\000\000\002\226\000\n\016\146\000\000\003\186\003\190\003\254\003\194\003\022\003\206\003\214\006\186\000\000\000\000\016\246\002\150\000\000\002\225\003\030\017\014\000\000\000\000\007\254\b\002\b\014\b\"\000\000\005Z\000\000\002\225\002\225\000\000\000\000\000\000\000\000\017\022\000\000\b\150\000\000\t\r\000\000\000\000\000\000\000\000\b\162\b\186\t\014\005f\005j\017*\017V\000\000\000\000\004m\004m\000\000\000\000\000\000\006J\024\206\000\000\t\r\000\000\000\000\015f\000\000\000\000\002f\000\000\017\146\021~\005n\b\022\024\238\000\173\000\000\b.\004V\t\"\000\173\000\000\002\162\000\173\000\000\002f\021&\tJ\000\000\000\000\002\218\000\000\000\000\000\173\000\000\000\173\000\000\000\173\000\000\000\173\001\210\000\238\tR\000\000\002\222\000\000\015j\000\000\000\000\000\000\tZ\000\173\000\000\000\000\000\000\002\226\000\000\000\173\000\000\000\000\015v\000\173\021J\003\022\001\190\015f\000\173\000\000\002f\000\173\002\150\000\000\000\000\003\030\000\173\000\173\000\173\007\254\b\002\b\014\000\000\012J\005Z\000\173\000\173\006\014\005j\000\000\005\206\024\210\000\173\000\000\000\000\t\r\000\173\006\026\021V\000\000\000\000\006&\000\000\000\000\005f\005j\000\173\000\173\015j\000\000\000\173\000\173\000\000\000\000\000\000\020\234\000\000\000\000\000\000\000\000\000\173\000\000\015v\000\000\021*\000\000\000\173\000\173\005n\b\022\000\000\000\000\000\197\b.\004V\000\000\000\173\000\197\000\173\002\162\000\197\000\000\002f\000\000\tJ\000\000\000\000\002\218\005j\000\000\000\197\000\000\000\197\000\000\000\197\000\000\000\197\001\210\0216\tR\000\000\002\222\003\178\000\000\002\162\000\000\000\000\tZ\000\197\000\000\b\182\003\142\002\226\000\000\000\197\020\234\000\000\007\198\000\197\000\000\003\022\001\190\001\210\000\197\000\000\000\000\000\197\002\150\000\000\000\000\003\030\000\197\000\197\000\197\007\254\b\002\b\014\000\000\012J\005Z\000\197\000\197\000\000\000\000\000\000\003\174\000\000\000\197\000\000\000\000\r\206\000\197\002\150\000\000\000\000\000\000\000\000\000\000\000\000\005f\005j\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\006\206\000\197\000\197\005n\b\022\000\000\000\000\000\000\b.\004V\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>\000\000\006\014\000\000\000B\005\206\000\000\012\181\012\161\000\000\000\000\000F\006\026\000\000\000\000\000\000\006&\000J\000\000\000N\000R\000V\000Z\000^\000b\000f\000\000\012\181\000\000\000j\000n\000\000\000r\002\030\000v\000\000\000\000\000\000\000\000\000\000\002\178\000\000\000\000\000\000\000\000\000\000\002&\000\000\000z\002*\012\161\000~\000\130\000\000\000\000\000\000\000\000\000\000\000\134\000\138\000\142\000\000\000\000\000\000\000\000\000\000\000\146\000\150\000\154\000\158\000\000\000\162\000\166\000\170\000\000\000\000\000\000\000\174\000\178\000\182\000\000\000\000\000\000\000\186\000\006\000\190\000\194\000\246\002\158\002\162\002\166\002\206\002f\000\198\000\000\000\202\000\000\002\218\000\000\000\000\004\141\000\206\000\210\000\000\000\214\000\000\003\154\001\210\000\000\000\000\000\000\002\222\000\000\003\"\003&\000\000\000\000\000\000\003\158\000\000\003*\000\000\002\226\000\000\016\146\000\000\003\186\003\190\000\000\003\194\003\022\003\206\003\214\006\186\000\000\000\000\016\246\002\150\000\000\000\000\003\030\017\014\000\000\000\000\007\254\b\002\b\014\b\"\000\000\005Z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\022\000\000\b\150\000\000\027\222\000\000\000\000\000\000\000\000\b\162\b\186\t\014\005f\005j\017*\017V\000\000\000\006\027\255\014\190\000\246\002\158\002\162\002\166\002\206\002f\000\000\000\000\000\000\000\000\002\218\000\000\000\000\028.\000\000\021~\005n\b\022\014>\003\154\001\210\b.\004V\t\"\002\222\000\000\003\"\003&\000\000\000\000\000\000\003\158\000\000\003*\000\000\002\226\000\000\016\146\000\000\003\186\003\190\000\000\003\194\003\022\003\206\003\214\006\186\000\000\016R\016\246\002\150\000\000\000\000\003\030\017\014\002\006\000\000\007\254\b\002\b\014\b\"\000\000\005Z\000\000\000\000\002\n\000\000\000\000\000\000\000\000\017\022\000\000\b\150\001\210\027\222\000\000\000\000\000\000\000\000\b\162\b\186\t\014\005f\005j\017*\017V\000\000\000\000\004\149\000\000\003~\000\000\000\000\000\000\001\006\000\000\006\230\001\222\000\000\000\000\003:\002\162\b\246\002\150\002f\021~\005n\b\022\000\000\002\218\001\n\b.\004V\t\"\002r\000\000\000\000\000\000\000\000\001\210\000\000\000\000\000\000\001\014\001\018\001\022\003Z\001\030\001\"\000\000\000\000\006\234\000\000\000\000\002\225\000\000\003^\002\225\001.\n\242\000\000\000\000\003V\001\190\0016\002\225\000\000\001:\000\000\002\150\000\000\000\000\003\218\000\000\000\000\002\225\003\222\000\000\003\230\005N\000\n\005Z\000\000\002\225\001>\001B\001F\001J\001N\000\000\000\000\000\n\001R\005^\000\000\002\225\001V\000\000\000\000\000\000\002\225\005f\005j\000\000\005\174\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\n\246\011\002\000\000\005n\000\000\000\000\001\158\000\000\001\162\004V\001\006\000\000\001\166\002\225\001\170\001\174\003:\002\162\n\150\002\225\002f\011\006\000\000\000\000\000\000\002\218\001\n\000\000\000\000\000\000\002r\000\000\000\000\000\000\000\000\001\210\000\000\000\000\000\000\001\014\001\018\001\022\003Z\001\030\001\"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003^\000\000\001.\n\242\000\000\000\000\003V\001\190\0016\000\000\000\238\001:\000\000\002\150\000\000\000\000\003\218\000\000\000\000\000\000\003\222\000\000\003\230\005N\000\000\005Z\000\000\000\000\001>\001B\001F\001J\001N\000\000\000\000\000\000\001R\005^\000\000\000\000\001V\007\173\000\000\000\000\000\000\005f\005j\000\000\005\174\001Z\000\000\000\000\000\000\000\000\006\014\001^\000\000\005\206\011\n\000\000\000\000\000\000\000\000\000\000\006\026\001\154\n\246\000\000\006&\005n\000\000\007\173\001\158\000\000\001\162\004V\001\006\000\000\001\166\000\000\001\170\001\174\003:\002\162\r\142\007\173\002f\000\000\007\173\b\138\000\000\002\218\001\n\000\000\000\000\007\173\002r\000\000\000\000\007\173\000\000\001\210\000\000\000\000\000\000\001\014\001\018\001\022\003Z\001\030\001\"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003^\000\000\001.\n\242\000\000\000\000\003V\001\190\0016\n\181\000\000\001:\000\000\002\150\000\000\000\000\003\218\000\000\000\000\000\000\003\222\000\000\003\230\005N\000\000\005Z\000\000\000\000\001>\001B\001F\001J\001N\000\000\000\000\000\000\001R\005^\000\000\n\181\001V\000\000\000\000\000\000\000\000\005f\005j\000\000\005\174\001Z\000\000\000\000\000\000\n\181\000\000\001^\n\181\011j\000\000\000\000\000\000\000\000\000\000\n\181\000\000\001\154\n\246\n\181\000\000\005n\000\000\000\000\001\158\000\000\001\162\004V\000\000\b\249\001\166\000\006\001\170\001\174\000\000\002\158\002\162\000\000\002\206\002f\000\000\000\000\000\000\000\000\002\218\000\000\000\000\000\000\000\000\b\249\000\000\b\249\b\249\000\000\001\210\000\000\000\000\000\000\002\222\000\000\003\"\003&\000\000\000\000\000\000\000\000\b\001\003*\000\000\002\226\000\000\b\001\000\000\003\186\003\190\n\194\003\194\003\022\003\206\003\214\006\186\001\202\001\206\011\"\002\150\000\000\000\000\003\030\000\000\000\000\b\001\007\254\b\002\b\014\b\"\000\000\005Z\000\000\000\000\000\000\001\210\002\142\001\230\000\000\000\000\000\000\b\150\000\000\000\000\000\000\001\242\000\000\b\001\b\162\b\186\t\014\005f\005j\000\000\000\000\b\001\000\000\000\000\001\246\002v\b\001\b\001\000\238\002\130\000\000\002\150\004\002\004\014\000\000\b\001\b\001\000\000\004\026\000\000\000\000\005n\b\022\b\249\004\253\004\253\b.\004V\t\"\004\253\000\000\004\253\004\253\000\000\004\253\004\030\004\253\004\253\b\001\000\000\004\253\b\001\004\253\004\253\004\253\004\253\004\253\004\253\004\253\004\253\b\001\004\253\016b\004\253\000\000\000\000\000\000\000\000\000\000\002\006\004\253\000\000\000\000\000\000\000\000\004\253\004\253\004\253\000\000\002\n\004\253\004\253\004\253\004\253\000\000\004\253\000\000\001\210\004\253\000\000\000\000\000\000\000\000\004\253\004\253\004\253\000\000\000\000\004\253\004\253\004\253\000\000\004\253\004\253\003~\000\000\000\000\000\000\000\000\004\253\006\230\001\222\000\000\004\253\004\253\000\000\004\253\002\150\004\253\000\000\000\000\000\000\000\000\004\253\004\253\004\253\000\000\004\253\004\253\004\253\004\253\000\000\004\253\004\253\000\000\000\000\000\000\004\253\000\000\004\253\004\253\000\000\000\000\002z\004\253\006\234\000\000\000\000\019\254\004\253\000\000\n\205\000\000\004\253\n\205\004\253\004\253\n\205\n\205\000\000\004\253\n\205\000\000\n\205\000\000\000\000\n\205\000\000\000\000\000\000\n\205\n\205\000\000\n\205\n\205\000\000\n\205\000\000\n\205\000\000\025\026\002\225\002\225\n\205\000\000\000\000\n\205\002\006\000\000\000\000\000\000\000\000\000\000\000\000\n\205\000\000\n\205\002\n\000\000\n\205\n\205\002\225\000\000\000\000\000\000\001\210\n\205\002\225\000\n\n\205\000\000\000\000\n\205\n\205\002\225\n\205\000\000\n\205\n\205\000\000\002\225\000\000\003~\002\225\002\225\000\000\000\000\000\000\006\230\001\222\n\205\000\000\000\000\000\000\000\000\002\150\002\225\000\000\n\205\n\205\000\000\000\000\n\205\000\000\n\205\000\000\000\000\000\000\000\000\005\138\000\000\000\000\000\000\000\000\001\202\001\206\n\205\n\205\000\000\n\205\n\205\000\000\n\205\006\234\n\205\000\000\n\205\000\000\n\205\000\000\n\205\b\229\b\229\001\210\001\214\001\230\b\229\000\000\001\206\b\229\000\000\000\000\000\000\001\242\000\000\000\000\018\146\b\229\000\000\b\229\b\229\b\229\000\000\b\229\b\229\b\229\001\246\019\250\000\000\019\026\000\000\002\130\000\000\002\150\004\002\004\014\000\000\b\229\000\000\000\000\020\n\000\000\000\000\b\229\b\229\000\000\000\000\b\229\000\000\000\000\002~\000\000\b\229\000\000\000\000\b\229\000\000\004\030\000\000\000\000\b\229\b\229\b\229\000\000\000\000\000\000\000\000\000\000\000\000\b\229\b\229\000\000\000\000\000\000\000\000\000\000\b\229\000\000\000\000\000\000\004~\000\000\000\000\b\229\000\000\000\000\000\000\000\000\000\000\000\000\b\229\b\229\b\229\000\000\b\229\b\229\000\000\004Y\000\000\000\000\000\000\000\000\004Y\000\000\b\229\004Y\b\229\b\229\000\000\000\000\000\000\b\229\000\000\000\000\000\000\004Y\b\229\000\000\000\000\004Y\b\229\004Y\b\229\b\229\012u\012u\000\000\000\000\004Y\012u\000\000\001\206\012u\004Y\000\000\000\000\000\000\000\000\000\000\004Y\004\158\000\000\012u\012u\012u\004&\012u\012u\012u\000\000\000\000\004Y\004Y\000\000\000\000\000\000\004Y\002\198\000\000\000\000\012u\000\000\000\000\000\000\000\000\000\000\012u\012u\000\000\000\000\012u\000\000\004Y\002~\004Y\012u\000\000\000\000\012u\000\000\000\000\000\000\004Y\012u\012u\012u\004Y\004Y\002\198\000\238\004Y\004Y\012u\012u\000\000\000\000\0046\004Y\000\000\012u\000\000\000\000\000\000\004~\000\000\000\000\012u\004Y\000\000\000\000\000\000\000\000\020\254\012u\012u\012u\000\000\012u\012u\000\000\004Y\000\000\004Y\000\000\000\000\004Y\000\000\012u\004Y\012u\012u\004Y\000\000\000\000\012u\000\000\000\000\000\000\004Y\012u\000\000\000\000\004Y\012u\004Y\012u\012u\b\233\b\233\000\000\000\000\000\000\b\233\000\000\001\206\b\233\004Y\000\000\000\000\000\000\000\000\000\000\004Y\b\233\000\000\b\233\b\233\b\233\000\000\b\233\b\233\b\233\000\000\000\000\004Y\000\000\000\000\000\000\000\000\004Y\002\198\000\000\000\000\b\233\000\000\000\000\000\000\000\000\000\000\b\233\b\233\000\000\000\000\b\233\000\000\004Y\002~\000\000\b\233\000\000\000\000\b\233\000\000\000\000\000\000\000\000\b\233\b\233\b\233\004Y\004Y\000\000\000\000\004Y\004Y\b\233\b\233\002\225\000\000\007R\000\000\000\000\b\233\000\000\002\225\000\000\004~\000\000\000\000\b\233\004Y\000\000\000\000\000\000\000\000\002\225\b\233\b\233\b\233\002\225\b\233\b\233\001*\000\n\002\225\002\225\002\225\000\000\000\000\002\225\b\233\002\225\b\233\b\233\002\225\002\225\002\225\b\233\002\225\002\225\002\225\002\225\b\233\002\225\002\225\002\225\b\233\002\225\b\233\b\233\000\000\002\225\000\n\000\000\002\225\000\n\002\225\000\000\002\225\000\000\002\225\002\225\000\n\000\000\002\225\002\225\000\n\002\225\002\225\002\225\002\225\000\000\000\000\002\225\002\225\000\000\002\225\002\225\002\225\002\225\002\225\002\225\000\000\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\000\000\002\225\000\000\000\000\000\000\000\000\000\000\000\000\002\225\002\225\002\225\002\225\002\225\000\000\000\000\000\000\002\225\002\225\002\225\002\225\002\225\000\000\006\141\000\000\0009\002\225\002\225\000\000\0009\0009\000\000\0009\0009\002\225\000\000\000\000\000\000\0009\000\000\002\225\000\000\003\162\006\141\002\225\002\225\000\000\000\000\0009\002\225\002\225\002\225\0009\006\194\0009\0009\000\000\000\000\000\000\000\000\000\000\0009\000\000\0009\000\000\000\000\000\000\0009\0009\000\000\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\000\000\000\000\000\000\0009\0009\0009\0009\0009\000\000\006\137\000\000\0005\000\000\000\000\000\000\0005\0005\000\000\0005\0005\000\000\000\000\000\000\000\000\0005\000\000\000\000\000\000\000\000\006\137\0009\0009\000\000\000\000\0005\0009\0009\0009\0005\000\000\0005\0005\000\000\000\000\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\000\000\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\153\000\000\012=\000\000\000\000\000\000\012=\012=\000\000\012=\012=\000\000\000\000\000\000\000\000\012=\000\000\000\000\000\000\000\000\006\153\0005\0005\000\000\000\000\012=\0005\0005\0005\012=\000\000\012=\012=\000\000\000\000\000\000\000\000\000\000\012=\000\000\012=\000\000\000\000\000\000\012=\012=\000\000\012=\012=\012=\012=\012=\000\000\000\000\000\000\012=\000\000\000\000\012=\000\000\000\000\000\000\012=\012=\012=\012=\000\000\012=\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\012=\012=\012=\012=\012=\000\000\006\149\000\000\0129\000\000\000\000\000\000\0129\0129\000\000\0129\0129\000\000\000\000\000\000\000\000\0129\000\000\000\000\000\000\000\000\006\149\012=\012=\000\000\000\000\0129\012=\012=\012=\0129\000\000\0129\0129\000\000\000\000\000\000\000\000\000\000\0129\000\000\0129\000\000\000\000\000\000\0129\0129\000\000\0129\0129\0129\0129\0129\000\000\001\202\001\206\0129\000\000\000\000\0129\000\000\000\000\000\000\0129\0129\0129\0129\000\000\0129\000\000\000\000\000\000\000\000\001\210\001\214\001\230\000\000\000\000\0129\000\000\000\000\000\000\000\000\001\242\000\000\0129\0129\0129\0129\0129\001\250\000\000\000\000\000\000\000\000\000\000\001\246\002v\000\000\000\000\000\000\002\130\000\000\002\150\004\002\004\014\012y\012y\000\000\000\000\004\026\012y\0129\0129\012y\000\000\000\000\0129\0129\0129\000\000\000\000\004n\000\000\012y\012y\012y\004\030\012y\012y\012y\000\000\001\021\000\000\000\000\000\000\000\000\001\021\000\000\000\000\000\000\000\000\012y\000\000\000\000\000\000\000\000\000\000\012y\012y\000\000\000\000\012y\000\000\000\000\000\000\001\021\012y\000\000\000\000\012y\000\000\000\000\000\000\000\000\012y\012y\012y\000\000\000\000\000\000\000\000\000\000\000\000\012y\012y\000\000\000\000\001\021\000\000\018\154\012y\000\000\000\000\000\000\012y\001\021\000\000\012y\000\000\000\000\001\021\000\000\000\000\000\000\012y\012y\012y\000\000\012y\012y\001\021\000\000\000\000\000\000\000\000\000\000\000\000\007\253\012y\000\006\012y\012y\007\253\002\158\002\162\012y\002\206\002f\000\000\000\000\012y\000\000\002\218\000\000\012y\001\021\012y\012y\000\000\003\226\000\000\007\253\001\210\000\000\001\021\000\000\002\222\000\000\003\"\003&\000\000\000\000\000\000\000\000\000\000\003*\000\000\002\226\000\000\000\000\000\000\003\186\003\190\007\253\003\194\003\022\003\206\003\214\006\186\000\000\000\000\007\253\002\150\000\000\000\000\003\030\007\253\007\253\000\238\007\254\b\002\b\014\b\"\000\000\005Z\007\253\007\253\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\150\000\000\000\000\000\000\000\000\000\000\000\000\b\162\b\186\t\014\005f\005j\000\000\000\000\007\253\000\000\000\000\007\253\000\000\000\000\000\000\000\000\000\000\000\006\000\000\000\000\007\253\002\158\002\162\000\000\002\206\002f\000\000\000\000\005n\b\022\002\218\000\000\000\000\b.\004V\t\"\000\000\014R\000\000\000\000\001\210\000\000\000\000\000\000\002\222\000\000\003\"\003&\000\000\000\000\000\000\001\197\000\000\003*\000\000\002\226\001\197\000\000\000\000\003\186\003\190\000\000\003\194\003\022\003\206\003\214\006\186\000\000\000\000\000\000\002\150\000\000\000\000\003\030\000\000\001\197\000\000\007\254\b\002\b\014\b\"\000\000\005Z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005-\012\217\b\150\000\000\000\000\0051\012\217\001\197\000\000\b\162\b\186\t\014\005f\005j\000\000\001\197\000\000\000\000\000\000\005-\001\197\001\197\000\238\005-\0051\000\000\003\029\003\029\0051\001\197\001\197\003\029\000\000\000\000\003\029\000\000\005n\b\022\000\000\000\000\000\000\b.\004V\t\"\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\004f\000\000\000\000\003\029\000\000\000\000\000\000\000\000\003\029\012\217\012\217\003\029\000\000\000\000\012\217\012\217\003\029\003\029\003\029\000\000\000\000\000\000\005-\000\000\000\000\003\029\003\029\0051\012\217\000\000\012\217\000\000\003\029\012\217\000\000\012\217\003\029\005-\000\000\003\029\005-\000\000\0051\000\000\000\000\0051\003\029\003\029\003\029\004}\003\029\003\029\000\000\000\000\018\170\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\154\n\217\000\000\003\029\n\217\003\029\003\029\003:\002\162\000\000\000\000\002f\000\000\006\138\000\000\000\000\002\218\000\000\000\000\000\000\n\217\n\217\018\214\n\217\n\217\000\000\001\210\000\000\006\170\000\000\016\246\000\000\000\000\003>\000\000\017\014\b\198\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\217\019\018\003J\000\000\000\000\003V\001\190\000\000\000\000\000\000\000\000\000\000\002\150\000\000\000\000\003\218\000\000\000\000\n\217\003\222\000\000\003\230\005N\n\162\005Z\000\000\004}\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019v\005^\001\202\001\206\000\000\000\000\000\000\000\000\000\000\005f\005j\000\000\005\174\n\217\000\000\n\217\000\000\000\000\000\000\000\000\000\000\001\210\001\214\000\000\000\000\000\000\000\000\n\217\000\000\000\000\n\217\n\217\000\000\005n\000\000\n\217\000\000\n\217\000\000\004V\n\213\n\217\000\000\n\213\001\246\002\134\003:\002\162\000\000\002\130\002f\002\150\004\002\004\014\000\000\002\218\000\000\000\000\004\026\n\213\n\213\000\000\n\213\n\213\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003>\000\000\000\000\004\030\000\000\000\000\025\250\000\000\000\000\000\000\000\000\n\213\000\000\003J\000\000\000\000\003V\001\190\000\000\000\000\000\000\000\000\025\230\002\150\000\000\000\000\003\218\000\000\000\000\n\213\003\222\000\000\003\230\005N\000\000\005Z\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\012Y\000\000\000\000\012Y\000\000\000\000\005f\005j\000\000\005\174\n\213\000\000\n\213\012Y\000\000\000\000\000\000\000\000\000\000\012Y\000\000\001\221\001\221\000\000\n\213\000\000\001\221\n\213\n\213\001\221\005n\012Y\n\213\000\000\n\213\000\000\004V\012Y\n\213\001\221\001\221\001\221\000\000\001\221\001\221\001\221\012Y\000\000\000\000\012Y\000\000\000\000\000\000\000\000\012Y\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\012Y\000\000\001\221\000\000\012Y\001\221\000\000\000\000\000\000\000\000\001\221\001\221\001\221\000\000\012Y\012Y\000\000\000\000\012Y\001\221\001\221\000\000\000\000\000\000\027\214\000\000\001\221\001\r\000\000\000\000\001\221\000\000\001\r\001\221\000\000\012Y\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\001\r\000\000\000\000\001\221\000\000\001\221\001\221\003:\002\162\000\000\001\221\002f\000\000\006\138\000\000\001\221\002\218\000\000\000\000\004\226\000\000\001\221\001\r\000\000\0036\000\000\001\210\000\000\006\170\000\000\001\r\000\000\000\000\003>\000\000\001\r\b\198\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\r\001\r\003J\000\000\000\000\n\146\001\190\000\000\000\000\000\000\000\000\000\000\002\150\000\000\000\000\003\218\000\000\000\000\n\177\003\222\000\000\003\230\000\000\n\162\005Z\000\000\001\r\000\000\003:\002\162\000\000\000\000\002f\000\000\006\138\001\r\005^\002\218\000\000\000\000\000\000\000\000\000\000\000\000\005f\005j\000\000\001\210\n\170\006\170\000\000\000\000\000\000\000\000\003>\000\000\000\000\b\198\000\000\000\000\000\000\000\000\n\177\n\178\000\000\n\177\011\030\003J\005n\000\000\n\146\001\190\n\177\000\000\004V\000\000\n\177\002\150\000\000\000\000\003\218\000\000\000\000\n\177\003\222\000\000\003\230\000\000\n\162\005Z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005f\005j\000\000\000\000\n\170\005}\005}\000\000\000\000\000\000\005}\000\000\000\000\005}\000\000\000\000\000\000\000\000\n\177\000\000\000\000\n\177\n\177\005}\005n\005}\000\000\005}\n\177\005}\004V\000\000\n\177\000\000\000\000\000\000\000\000\000\000\000\000\000\246\000\000\005}\002\166\000\000\000\000\000\000\000\000\005}\005}\000\000\000\000\000\000\028.\005}\000\000\000\000\005}\000\000\003\154\005}\000\000\000\000\000\000\000\000\005}\005}\005}\000\000\000\000\000\000\003\158\000\000\000\000\000\000\000\000\000\000\016\146\000\000\000\000\000\000\005}\005}\000\000\000\000\005}\024>\000\000\001\006\016\246\000\000\000\000\000\000\000\000\017\014\005}\005}\005}\000\000\005}\005}\000\000\000\000\000\000\001\n\007R\000\000\000\000\002r\000\000\017\022\000\000\005}\000\000\027\222\005}\005}\001\014\001\018\001\022\001\026\001\030\001\"\000\000\017*\017V\000\000\005}\004\149\000\000\001&\000\000\001.\0012\000\000\000\000\000\000\000\000\0016\004a\000\000\001:\000\000\000\000\000\246\021~\000\000\002\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\150\001>\001B\001F\001J\001N\003\154\005q\005q\001R\000\000\000\000\005q\001V\000\000\005q\000\000\000\000\017\154\000\000\000\000\000\000\001Z\000\000\017\194\005q\000\000\005q\001^\005q\000\000\005q\000\000\000\000\000\000\000\000\016\246\000\000\001\154\027\018\000\000\017\014\000\000\005q\000\000\001\158\000\000\001\162\000\000\005q\005q\001\166\000\000\001\170\001\174\007\194\000\000\018>\005q\000\000\000\000\005q\000\000\000\000\000\000\000\000\005q\005q\000\238\000\000\000\000\017*\018R\000\000\000\000\004a\004a\000\000\000\000\000\000\000\000\000\000\005q\005q\000\000\000\000\005q\000\000\b\245\000\000\000\000\000\000\018b\000\000\000\000\000\000\005q\005q\005q\000\000\005q\005q\000\000\000\000\t\174\000\000\000\000\012\030\b\245\000\000\b\245\b\245\000\000\005q\000\000\000\000\005q\005q\t\230\t\254\n\006\t\238\n\014\000\000\000\000\001\202\002b\000\000\005q\002f\000\000\000\000\n\022\n\030\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n&\000\000\000\000\001\210\001\214\001\230\002j\000\000\000\238\000\000\000\000\000\000\000\000\001\242\001\006\000\000\000\000\t\182\t\246\n.\n6\nF\000\000\000\000\000\000\000\000\002n\002v\000\000\nN\001\n\002\130\000\000\002\150\004\002\004\014\000\000\000\000\nV\000\000\020\214\000\000\020\218\001\014\001\018\001\022\001\026\001\030\001\"\000\000\000\000\000\000\nv\000\000\n~\n>\001&\004\030\001.\0012\b\245\n^\000\000\000\000\0016\000\000\005j\001:\000\000\nf\nn\000\000\000\000\000\000\000\000\000\000\020\230\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001>\001B\001F\001J\001N\000\000\003]\003]\001R\020\234\000\000\003]\001V\000\000\003]\000\000\000\000\000\000\000\000\000\000\000\000\001Z\000\000\000\000\003]\000\000\003]\001^\003]\000\000\003]\000\000\000\000\000\000\000\000\000\000\000\000\001\154\027.\000\000\000\000\000\000\003]\000\000\001\158\000\000\001\162\000\000\003]\003]\001\166\000\000\001\170\001\174\005\005\000\000\000\000\003]\000\000\000\000\003]\000\000\000\000\000\000\000\000\003]\003]\003]\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003]\000\000\001\202\001\206\003]\bq\bq\000\000\000\000\000\000\bq\000\000\000\000\bq\003]\003]\003]\000\000\003]\003]\000\000\001\210\001\214\bq\005\005\bq\000\000\bq\000\000\bq\000\000\003]\000\000\000\000\000\000\003]\000\000\000\000\000\000\000\000\000\000\bq\000\000\000\000\001\246\002~\003]\bq\bq\002\130\000\000\002\150\004\002\004\014\000\000\000\000\bq\000\000\004\026\bq\015\130\000\000\000\000\000\000\bq\bq\bq\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\030\000\000\000\000\000\000\000\000\bq\000\000\000\000\000\000\bq\r%\r%\000\000\000\000\000\000\r%\000\000\000\000\r%\bq\bq\bq\000\000\bq\bq\000\000\000\000\000\000\r%\000\000\r%\000\000\r%\bq\r%\000\000\bq\000\000\000\000\000\000\bq\000\000\000\000\000\000\000\000\000\000\r%\000\000\000\000\004\226\000\000\bq\r%\r%\r)\r)\000\000\000\000\004&\r)\000\000\r%\r)\000\000\r%\000\000\000\000\000\000\000\000\r%\r%\r%\r)\000\000\r)\000\000\r)\000\000\r)\000\000\000\000\000\000\000\000\000\000\000\000\r%\000\000\000\000\000\000\r%\r)\000\000\000\000\000\000\000\000\000\000\r)\r)\000\000\r%\r%\r%\004&\r%\r%\r)\000\000\000\000\r)\0046\000\000\000\000\000\000\r)\r)\r)\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)\000\000\r%\000\000\r)\003]\003]\000\000\000\000\000\000\003]\000\000\000\000\003]\r)\r)\r)\000\000\r)\r)\000\000\000\000\000\000\003]\0046\003]\000\000\003]\000\000\003]\000\000\r)\001\202\001\206\000\000\r)\000\000\000\000\000\000\000\000\000\000\003]\000\000\000\000\000\000\000\000\r)\003]\003]\000\000\000\000\001\210\001\214\005\t\000\000\000\000\003]\000\000\000\000\003]\000\000\000\000\000\000\000\000\003]\003]\003]\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\246\002\134\000\000\000\000\000\000\002\130\003]\002\150\004\002\004\014\003]\001\205\000\000\000\000\004\026\000\000\001\205\000\000\001\206\001\205\003]\003]\003]\000\000\003]\003]\000\000\b\209\000\000\001\205\005\t\004\030\000\000\001\205\004\205\001\205\000\000\003]\000\000\000\000\000\000\003]\000\000\004Y\000\000\000\000\000\000\001\205\004Y\000\000\025\230\000\000\003]\001\205\001\205\000\000\000\000\000\000\000\000\000\000\002~\000\000\001\205\000\000\000\000\001\205\000\000\004Y\000\000\000\000\001\205\001\205\001\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\001\205\001\205\000\000\004Y\004~\003A\000\000\000\000\000\000\000\000\003A\004Y\001\206\003A\001\205\001\205\004Y\002\198\001\205\001\205\000\000\b\205\000\000\003A\000\000\004Y\004Y\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\000\000\000\000\000\000\000\000\001\205\003A\001\201\000\000\000\181\004Y\000\000\000\000\002~\000\181\003A\000\000\000\181\003A\004Y\000\000\000\000\000\000\003A\003A\003A\000\000\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~\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\006\221\000\185\000\000\000\000\000\185\006\221\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\006\221\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\006\221\000\185\000\000\000\000\000\185\000\000\000\000\000\000\006\221\000\185\000\185\000\238\000\000\006\221\006\221\000\238\000\000\000\000\000\185\000\185\000\000\000\000\006\221\006\221\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\006\221\000\000\001\169\012\229\001\169\000\185\000\000\000\000\012\229\006\221\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\023\158\000\000\012\229\005\005\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\012\229\000\000\000\000\000\000\000\000\000\000\001\169\000\000\012\229\000\000\001\169\r!\r!\012\229\012\229\000\238\r!\000\000\000\000\r!\001\169\001\169\012\229\012\229\001\169\001\169\000\000\000\000\000\000\r!\005\005\r!\000\000\r!\001\169\r!\000\000\000\000\000\000\000\000\001\169\001\169\000\000\000\000\000\000\000\000\001\169\r!\012\229\000\000\000\000\000\000\001\169\r!\r!\000\000\000\000\012\229\000\000\000\000\000\000\000\000\r!\000\000\000\000\r!\000\000\000\000\000\000\000\000\r!\r!\r!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r!\000\000\000\000\000\000\r!\r\029\r\029\000\000\000\000\000\000\r\029\000\000\000\000\r\029\r!\r!\r!\000\000\r!\r!\000\000\000\000\000\000\r\029\000\000\r\029\000\000\r\029\000\000\r\029\000\000\r!\000\000\000\000\000\000\r!\000\000\000\000\000\000\000\000\000\000\r\029\000\000\000\000\004\226\000\000\r!\r\029\r\029\000\000\000\000\000\000\000\000\000\000\000\000\004a\r\029\000\000\000\000\r\029\000\246\000\000\000\000\002\018\r\029\r\029\r\029\000\000\000\000\000\000\000\000\000\000\000\000\017\150\000\000\000\000\000\000\004a\000\000\003\154\r\029\000\000\bu\bu\r\029\000\000\000\000\bu\000\000\000\000\bu\017\154\000\000\000\000\r\029\r\029\r\029\017\194\r\029\r\029\bu\000\000\bu\000\000\bu\000\000\bu\000\000\007.\016\246\000\000\r\029\000\000\000\000\017\014\r\029\000\000\000\000\bu\000\000\000\000\000\000\000\000\000\000\bu\bu\r\029\000\000\000\000\000\000\018>\000\000\000\000\bu\000\000\000\000\bu\000\000\000\000\000\000\000\000\bu\bu\000\238\017*\018R\000\000\000\000\004a\004a\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bu\000\000\000\000\000\000\bu\000\000\006\241\000\000\018b\000\000\000\000\000\000\000\000\000\000\bu\bu\bu\000\000\bu\bu\000\000\000\000\t\174\000\000\000\000\006\241\000\000\000\000\bu\006\241\000\000\bu\000\000\000\000\000\000\bu\t\230\t\254\n\006\t\238\n\014\000\000\000\000\000\000\000\000\000\000\bu\001\201\000\000\000\000\n\022\n\030\001\201\000\000\001\206\001\201\000\000\000\000\000\000\n&\000\000\000\000\000\000\b\205\000\000\001\201\000\000\000\238\000\000\001\201\000\000\001\201\000\000\000\000\000\000\000\000\t\182\t\246\n.\n6\nF\000\000\000\000\001\201\000\000\000\000\000\000\006\241\nN\001\201\000\000\000\000\000\000\000\000\000\000\000\000\002~\nV\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\nv\000\000\n~\n>\000\000\000\000\000\000\000\000\000\000\n^\000\000\001\201\001\201\000\000\000\000\004~\000\000\nf\nn\000\000\000\000\000\000\016F\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\t\174\001\201\000\000\000\000\016J\000\000\000\000\000\000\001\201\000\000\000\000\000\000\000\000\001\201\t\230\t\254\n\006\t\238\n\014\001\201\000\000\000\000\000\000\000\000\000\000\n\182\000\000\000\000\n\022\n\030\000\246\001\202\001\206\002\018\000\000\000\000\000\000\n&\000\000\000\000\000\000\000\000\000\000\017\150\000\000\000\238\000\000\004a\000\000\003\154\001\210\001\214\001\230\000\000\t\182\t\246\n.\n6\nF\000\000\001\242\017\154\000\000\000\000\000\000\000\000\nN\017\194\000\000\000\000\000\000\000\000\000\000\001\246\002v\nV\000\000\000\000\002\130\016\246\002\150\004\002\004\014\000\000\017\014\000\000\000\000\004\026\000\000\nv\016N\n~\n>\016^\000\000\000\000\000\000\000\000\n^\000\000\018>\000\000\000\000\000\000\004\030\000\000\nf\nn\005\169\005\169\000\000\000\000\000\000\005\169\017*\018R\005\169\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\169\000\000\005\169\000\000\005\169\000\000\005\169\000\000\000\000\018b\000\000\000\000\000\000\000\000\004R\000\000\004V\000\000\005\169\000\000\000\000\000\000\000\000\000\000\005\169\005\169\000\000\000\000\000\000\000\000\007\194\000\000\000\000\005\169\000\000\000\000\005\169\000\000\006I\000\000\000\000\005\169\005\169\000\238\000\000\002\162\000\000\000\000\002f\000\000\000\000\000\000\000\000\002\218\000\000\002\225\002\225\005\169\006I\002\225\000\000\005\169\000\000\001\210\002\225\000\000\000\000\002\222\000\000\000\000\002\225\005\169\005\169\005\169\002\225\005\169\005\169\000\000\002\226\000\000\000\000\002\225\000\n\000\000\000\000\006\190\003\022\001\190\005\169\000\000\000\000\015\030\005\169\002\150\002\225\000\000\003\030\002\225\002\225\000\000\007\254\b\002\b\014\005\169\002\225\005Z\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\165\007\002\000\000\005f\005j\005\165\002\225\000\000\005\165\000\000\000\000\000\000\000\000\000\000\002\225\002\225\000\000\015Z\005\165\000\000\005\165\000\000\005\165\000\000\005\165\000\000\000\000\005n\b\022\000\000\000\000\000\000\b.\004V\000\000\000\000\005\165\000\000\002\225\000\000\000\000\000\000\005\165\007n\002\225\000\000\000\000\000\000\000\000\000\000\000\000\005\165\000\000\000\000\005\165\000\000\000\000\004\133\000\000\005\165\005\165\000\238\021\166\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\165\000\000\005\193\005\193\005\165\000\000\003\154\005\193\000\000\000\000\005\193\000\000\000\000\000\000\005\165\005\165\005\165\000\000\005\165\005\165\005\193\000\000\005\193\000\000\005\193\000\000\005\193\000\000\022\022\000\000\000\000\005\165\000\000\000\000\000\000\005\165\016\246\000\000\005\193\000\000\000\000\017\014\000\000\000\000\005\193\005\193\005\165\000\000\000\000\000\000\022\186\022\202\000\000\005\193\000\000\000\000\005\193\000\000\000\000\000\000\000\000\005\193\005\193\005\193\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\133\005\193\000\000\005\189\007\002\005\193\000\000\000\000\005\189\023\190\000\000\005\189\000\000\000\000\000\000\005\193\005\193\005\193\000\000\005\193\005\193\005\189\000\000\005\189\000\000\005\189\000\000\005\189\000\000\000\000\000\000\000\000\005\193\000\000\000\000\000\000\005\193\000\000\000\000\005\189\000\000\000\000\000\000\000\000\000\000\005\189\007n\007f\000\000\000\000\000\000\000\000\000\000\000\000\005\189\000\000\000\000\005\189\000\000\000\000\000\000\000\000\005\189\005\189\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\189\003:\002\162\000\000\005\189\002f\000\000\006\138\000\000\000\000\002\218\000\000\000\000\000\000\005\189\005\189\005\189\000\000\005\189\005\189\001\210\000\000\006\170\000\000\000\000\000\000\000\000\003>\000\000\000\000\b\198\005\189\000\000\000\000\000\000\005\189\000\000\000\000\000\000\000\000\003J\000\000\000\000\n\146\001\190\000\000\005\189\012\158\000\000\000\000\002\150\000\000\000\000\003\218\000\000\000\000\000\000\003\222\000\000\003\230\000\000\n\162\005Z\t\174\000\000\000\000\012\030\000\000\000\000\000\000\b\245\000\000\000\000\000\000\005^\000\000\000\000\t\230\t\254\n\006\t\238\n\014\005f\005j\000\000\000\000\n\170\000\000\000\000\000\000\000\000\n\022\n\030\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n&\n\178\000\000\000\000\n\190\000\000\005n\000\000\000\238\000\000\000\000\000\000\004V\000\000\000\000\000\000\000\000\t\182\t\246\n.\n6\nF\000\000\003=\000\000\000\000\000\000\000\000\003=\nN\001\206\003=\000\000\000\000\000\000\000\000\000\000\000\000\nV\000\000\000\000\003=\000\000\000\000\000\000\003=\000\000\003=\000\000\000\000\000\000\000\000\nv\000\000\n~\n>\000\000\000\000\000\000\003=\000\000\n^\000\000\000\000\000\000\003=\000\000\000\000\001M\nf\nn\000\000\002~\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~\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\153\001\133\001I\001I\001I\000\000\001I\001I\000\000\012\153\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\153\000\000\000\000\000\000\000\000\000\000\012\153\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\153\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\015f\001\213\000\000\002f\000\000\0019\000\000\000\000\000\000\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\000\000\000\000\000\000\001\213\000\000\000\000\000\000\000\000\000\000\001\213\000\000\000\000\000\000\000\000\0019\015j\000\000\000\000\001\213\000\000\000\000\001\213\000\000\000\000\000\000\0019\001\213\001\213\000\000\015v\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\213\000Y\000\000\000\000\001\213\000\000\000Y\000\000\000Y\000\000\000\000\000\000\000\000\005j\001\213\001\213\000\000\000Y\001\213\001\213\000Y\000\000\000\000\000\000\000Y\000Y\000\000\b\145\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\003:\002\162\000\000\000\000\002f\000\000\006\138\000\000\000Y\002\218\000\000\000Y\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\210\000Y\006\170\000\000\000Y\000\000\000\000\003>\000\000\b\145\b\198\000\000\000\000\000Y\004Y\007\002\000Y\000\000\t\n\004Y\003J\000\000\004Y\r\138\001\190\000\000\000\000\000\000\000\000\000Y\002\150\000\000\004Y\003\218\000\000\000\000\004Y\003\222\004Y\003\230\000\000\n\162\005Z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004Y\000\000\000\000\000\000\005^\000\000\004Y\007n\000\000\000\000\004Y\000\000\005f\005j\000\000\004Y\000\000\000\000\004Y\000\000\000\000\000\000\000\000\004Y\002\198\000\238\000\000\000\000\000\000\000\000\000\000\000\000\004Y\004Y\r\154\000\000\005n\000\000\000\000\004Y\004Y\000\000\004V\004Y\000\000\011\250\000\000\000\000\000\000\000\000\011\250\000\000\000\000\004Y\004Y\000\000\000\000\004Y\004Y\000\000\000\000\t\174\000\000\000\000\000\000\000\000\t\174\004Y\011\254\000\000\000\000\000\000\000\000\012\214\004Y\t\230\t\254\n\006\t\238\n\014\t\230\t\254\n\006\t\238\n\014\004Y\000\000\000\000\000\000\n\022\n\030\000\000\000\000\000\000\n\022\n\030\000\000\000\000\n&\000\000\000\000\000\000\000\000\n&\000\000\000\000\000\238\000\000\000\000\000\000\000\000\000\238\000\000\000\000\000\000\t\182\t\246\n.\n6\nF\t\182\t\246\n.\n6\nF\000\000\000\000\nN\000\000\000\000\000\000\000\000\nN\000\000\000\000\000\000\nV\000\000\0035\000\000\000\000\nV\000\000\0035\000\000\000\000\0035\000\000\000\000\000\000\nv\000\000\n~\n>\000\000\nv\0035\n~\n>\n^\0035\000\000\0035\000\000\n^\000\000\000\000\nf\nn\000\000\000\000\000\000\nf\nn\0035\015~\000\000\000\000\000\000\000\000\0035\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0035\000\000\000\000\0035\000\000\000\000\000\000\000\000\0035\0035\0035\003:\002\162\000\000\000\000\002f\000\000\006\138\000\000\000\000\002\218\000\000\000\000\000\000\0035\000\000\000\000\000\000\0035\000\000\001\210\000\000\006\170\000\000\000\000\000\000\000\000\003>\0035\0035\b\198\000\000\0035\0035\000\000\000\000\000\000\000\000\023&\000\000\003J\000\000\0035\003V\001\190\000\000\000\000\000\000\015\222\0035\002\150\000\000\000\000\003\218\0035\000\000\000\000\003\222\000\000\003\230\0035\n\162\005Z\000\000\000\000\000\000\003:\002\162\000\000\000\000\002f\000\000\006\138\000\000\005^\002\218\000\000\000\000\000\000\000\000\000\000\000\000\005f\005j\000\000\001\210\021\150\006\170\000\000\000\000\000\000\000\000\003>\000\000\000\000\b\198\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\023\242\003J\005n\000\000\n\146\001\190\000\000\000\000\004V\000\000\000\000\002\150\000\000\000\000\003\218\000\000\000\000\000\000\003\222\000\000\003\230\000\000\n\162\005Z\000\000\000\000\000\000\003:\002\162\000\000\000\000\002f\000\000\006\138\000\000\005^\002\218\000\000\000\000\000\000\000\000\000\000\000\000\005f\005j\000\000\001\210\n\170\006\170\000\000\000\000\000\000\000\000\003>\000\000\000\000\b\198\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\022.\003J\005n\000\000\n\146\001\190\000\000\000\000\004V\000\000\000\000\002\150\000\000\000\000\003\218\000\000\000\000\000\000\003\222\000\000\003\230\005\166\n\162\005Z\000\000\000\000\000\000\003:\002\162\000\000\000\000\002f\000\000\000\000\000\000\005^\002\218\000\000\000\000\000\000\000\000\005\170\000\000\005f\005j\000\000\001\210\n\170\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\022\142\003J\005n\000\000\003V\001\190\000\000\000\000\004V\000\000\000\000\002\150\000\000\000\000\003\218\000\000\000\000\000\000\003\222\000\000\003\230\005N\000\000\005Z\000\000\000\000\t\017\000\000\000\000\000\000\000\000\000\000\003:\002\162\000\000\005^\002f\000\000\000\000\000\000\000\000\002\218\000\000\005f\005j\000\000\005\174\000\000\t\017\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003>\000\000\000\000\000\000\000\000\000\000\005\250\000\000\000\000\005n\002\225\002\225\000\000\003J\002\225\004V\003V\001\190\000\000\002\225\000\000\000\000\000\000\002\150\000\000\000\000\003\218\000\000\000\000\002\225\003\222\000\000\003\230\005N\000\000\005Z\002\225\000\n\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005^\000\000\002\225\000\000\000\000\002\225\002\225\000\000\005f\005j\000\000\005\174\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\005n\000\000\t\017\000\000\002\225\000\000\004V\004A\004A\000\000\000\000\004A\002\225\002\225\000\000\002\225\004A\000\000\000\000\000\000\000\000\000\000\004A\000\000\000\000\000\000\004A\000\000\000\000\000\000\000\000\000\000\000\000\004A\022\222\000\000\002\225\022\246\000\000\000\000\002\225\000\000\002\225\000\000\000\000\000\000\004A\000\000\000\000\004A\004A\000\000\000\000\000\000\000\000\000\000\004A\000\000\000\000\004A\000\000\000\000\000\238\004A\000\000\004A\004A\000\000\004A\0035\000\000\000\000\000\000\0035\0035\000\000\000\000\0035\0035\000\000\004A\0035\000\000\000\000\000\000\000\000\000\000\0035\004A\004A\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~\000\000\000\000\0035\015~\0035\004A\000\000\000\000\0035\000\000\000\000\004A\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\025j\000\000\0035\0035\025\154\000\000\0035\0035\012\145\000\000\000\000\000\000\000\000\012\145\000\000\000\000\012\145\000\000\015\222\0035\000\000\000\000\015\222\0035\0035\000\000\012\145\000\000\0035\000\000\012\145\000\000\012\145\000\000\000\000\000\000\000\000\000\000\004\253\000\000\000\000\000\000\000\000\000\000\012\145\000\000\000\000\000\000\000\000\000\000\012\145\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\145\000\000\000\000\012\145\000\000\000\000\003:\002\162\012\145\012\145\002f\000\000\006\138\000\000\000\000\002\218\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\145\001\210\000\000\006\170\012\145\000\000\000\000\000\000\003>\000\000\000\000\b\198\000\000\000\000\012\145\012\145\002^\000\000\012\145\012\145\000\000\003J\000\000\000\000\b\242\001\190\000\000\000\000\012\145\000\000\000\000\002\150\026Z\000\000\003\218\012\145\000\000\000\000\003\222\000\000\003\230\000\000\n\162\005Z\005U\000\000\012\145\000\000\000\000\005U\000\000\000\000\005U\000\000\000\000\005^\000\000\000\000\000\000\000\000\000\000\000\000\005U\005f\005j\000\000\005U\000\000\005U\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005U\000\000\000\000\000\000\000\000\000\000\005U\005n\000\000\000\000\000\000\000\000\007\194\004V\000\000\005U\000\000\000\000\005U\000\000\000\000\000\000\000\000\005U\005U\000\238\000\000\005Y\000\000\000\000\000\000\000\000\005Y\000\000\000\000\005Y\000\000\000\000\000\000\005U\005U\000\000\000\000\005U\000\000\005Y\000\000\000\000\000\000\005Y\000\000\005Y\000\000\005U\005U\000\000\000\000\005U\005U\000\000\000\000\000\000\000\000\005Y\000\000\000\000\000\000\000\000\000\000\005Y\000\000\0035\000\000\000\000\005U\007\194\0035\000\000\005Y\0035\000\000\005Y\000\000\000\000\000\000\005U\005Y\005Y\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\005Y\005Y\000\000\000\000\005Y\0035\015~\000\000\000\000\000\000\000\000\0035\000\000\000\000\005Y\005Y\000\000\000\000\005Y\005Y\0035\000\000\000\000\0035\000\000\000\000\000\000\000\000\0035\0035\0035\006\001\000\000\000\000\000\000\005Y\006\001\000\000\000\000\006\001\000\000\000\000\000\000\000\000\0035\000\000\005Y\000\000\0035\006\001\000\000\000\000\000\000\006\001\000\000\006\001\000\000\000\000\0035\0035\017f\000\000\0035\0035\000\000\000\000\000\000\006\001\000\000\000\000\000\000\000\000\000\000\006\001\000\000\000\000\000\000\000\000\015\222\0035\000\000\000\000\006\001\000\000\000\000\006\001\000\000\000\000\000\000\000\000\006\001\006\001\000\238\000\000\000\000\000\000\000\000\000\000\025B\000\000\000\000\000\000\000\000\000\000\003:\002\162\006\001\000\000\002f\000\000\006\001\000\000\000\000\002\218\000\000\000\000\000\000\000\000\000\000\000\000\006\001\006\001\021\"\001\210\006\001\006\001\000\000\000\000\000\000\000\000\003>\001\202\001\206\000\000\006\001\000\000\000\000\000\000\000\000\000\000\000\000\006\001\000\000\003J\000\000\000\000\003V\001\190\000\000\000\000\001\210\001\214\006\001\002\150\000\000\000\000\003\218\000\000\000\000\000\000\003\222\000\000\003\230\005N\000\000\005Z\000\000\000\000\000\000\005\210\000\000\000\000\000\000\001\246\002\134\003:\002\162\005^\002\130\002f\002\150\004\002\004\014\000\000\002\218\005f\005j\004\026\005\174\000\000\000\000\003\226\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003>\000\000\000\000\004\030\000\000\000\000\004\209\000\000\005n\000\000\006v\000\000\b\174\003J\004V\000\000\003V\001\190\000\000\000\000\000\000\000\000\025\230\002\150\000\000\000\000\003\218\000\000\000\000\000\000\003\222\000\000\003\230\005N\000\000\005Z\000\000\000\000\006\018\000\000\000\000\000\000\000\000\000\000\003:\002\162\000\000\005^\002f\000\000\000\000\000\000\000\000\002\218\000\000\005f\005j\000\000\005\174\000\000\0066\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003>\000\000\000\000\000\000\006\030\000\000\000\000\000\000\000\000\005n\003:\002\162\000\000\003J\002f\004V\003V\001\190\000\000\002\218\000\000\000\000\000\000\002\150\000\000\000\000\003\218\000\000\000\000\001\210\003\222\000\000\003\230\005N\000\000\005Z\003>\000\000\000\000\000\000\000\000\007\129\000\000\000\000\007\129\000\000\000\000\005^\000\000\003J\000\000\000\000\003V\001\190\000\000\005f\005j\000\000\005\174\002\150\007\129\007\129\003\218\007\129\007\129\000\000\003\222\000\000\003\230\005N\000\000\005Z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005n\006M\000\000\000\000\005^\007\129\004V\003:\002\162\000\000\000\000\002f\005f\005j\000\000\005\174\002\218\000\000\000\000\000\000\000\000\006M\000\000\007\129\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003>\000\000\000\000\005n\011\138\000\000\000\000\000\000\000\000\004V\003:\002\162\000\000\003J\002f\000\000\003V\001\190\000\000\002\218\007\129\000\000\007\129\002\150\000\000\000\000\003\218\000\000\000\000\001\210\003\222\000\000\003\230\005N\005\198\005Z\003>\007\129\007\129\000\000\000\000\000\000\007\129\000\000\007\129\000\000\000\000\005^\007\129\003J\000\000\000\000\003V\001\190\000\000\005f\005j\000\000\000\000\002\150\000\000\000\000\003\218\000\000\000\000\000\000\003\222\000\000\003\230\005N\000\000\005Z\000\000\000\000\011\150\000\000\000\000\000\000\000\000\005n\003:\002\162\000\000\005^\002f\004V\000\000\000\000\000\000\002\218\000\000\005f\005j\000\000\005\174\000\000\000\000\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003>\000\000\000\000\000\000\011\162\000\000\000\000\000\000\000\000\005n\003:\002\162\000\000\003J\002f\004V\003V\001\190\000\000\002\218\000\000\000\000\000\000\002\150\000\000\000\000\003\218\000\000\000\000\001\210\003\222\000\000\003\230\005N\000\000\005Z\003>\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005^\000\000\003J\000\000\000\000\003V\001\190\000\000\005f\005j\000\000\005\174\002\150\000\000\000\000\003\218\000\000\000\000\000\000\003\222\000\000\003\230\005N\000\000\005Z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005n\006q\000\000\000\000\005^\000\000\004V\000\000\002\162\000\000\000\000\002f\005f\005j\000\000\005\174\002\218\000\000\000\000\000\000\000\000\006q\000\000\000\000\000\000\000\000\001\210\000\000\000\000\000\000\002\222\000\000\000\000\000\000\000\000\000\000\005n\000\000\000\000\000\000\000\000\002\226\004V\000\000\000\000\000\000\000\000\000\000\000\000\003\022\001\190\000\000\000\000\000\000\000\000\000\000\002\150\000\000\000\000\003\030\000\000\000\000\000\000\007\254\b\002\b\014\000\000\000\000\005Z\000\000\000\000\000\000\006\249\007\002\000\000\000\000\000\000\006\249\000\000\000\000\006\249\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005f\005j\006\249\000\000\000\000\000\000\006\249\000\000\006\249\000\000\001\181\000\000\000\000\000\000\000\000\001\181\000\000\000\000\001\181\000\000\006\249\000\000\000\000\000\000\005n\b\022\006\249\007n\001\181\b.\004V\000\000\001\181\000\000\001\181\006\249\000\000\000\000\006\249\000\000\000\000\000\000\000\000\006\249\006\249\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\006\249\000\000\001\181\000\000\006\249\001\181\000\000\000\000\000\000\000\000\001\181\001\181\001\181\000\000\006\249\006\249\000\000\000\000\006\249\006\249\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\006\249\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\017r\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\005\000\000\000\000\000\000\000\000\006\005\001\217\000\000\006\005\001\217\000\000\000\000\000\000\000\000\001\217\001\217\000\000\000\000\006\005\000\000\000\000\000\000\006\005\000\000\006\005\000\000\000\000\000\000\000\000\000\000\001\217\000\000\000\000\000\000\001\217\000\000\006\005\000\000\000\000\000\000\000\000\000\000\006\005\000\000\001\217\001\217\000\000\000\000\001\217\001\217\000\000\006\005\000\000\000\000\006\005\000\000\000\000\000\000\001\217\006\005\006\005\000\238\000\000\000\000\000\000\001\217\000\000\000\000\000\000\000\000\020\254\000\000\000\000\000\000\000\000\006\005\001\217\012\145\000\000\006\005\000\000\000\000\012\145\000\000\000\000\012\145\000\000\000\000\000\000\006\005\006\005\000\000\000\000\006\005\006\005\012\145\000\000\000\000\000\000\012\145\000\000\012\145\000\000\006\005\000\000\000\000\000\000\004\253\000\000\000\000\006\005\000\000\000\000\012\145\000\000\000\000\000\000\000\000\000\000\012\145\000\000\006\005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\145\000\000\000\000\000\000\000\000\012\145\012\145\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012I\000\000\002\162\012I\000\000\027\230\000\000\012\145\000\000\000\000\027\234\000\000\000\000\012I\000\000\000\000\000\000\000\000\000\000\012I\000\000\012\145\012\145\002^\000\000\012\145\012\145\000\000\000\000\000\000\000\000\012I\000\000\000\000\000\000\012\145\000\000\012I\000\000\026\146\000\000\000\000\012\145\001\002\001\190\000\000\012I\000\000\000\000\012I\000\000\000\000\000\000\012\145\012I\004Y\000\000\000\000\000\000\000\000\004Y\000\000\027\238\004Y\000\000\000\000\000\000\000\000\000\000\000\000\012I\000\000\000\000\004Y\012I\000\000\000\000\004Y\000\000\004Y\000\000\000\000\000\000\027\242\012I\012I\000\000\000\000\012I\000\000\000\000\004Y\000\000\000\000\000\000\000\000\000\000\004Y\b1\b1\000\000\000\000\b1\007\194\000\000\012I\004Y\b1\000\000\004Y\000\000\000\000\000\000\016\014\004Y\002\198\000\238\b1\000\000\000\000\000\000\000\000\000\000\000\000\b1\000\000\000\000\000\000\000\000\000\000\004Y\000\000\000\000\000\000\004Y\000\000\000\000\b1\000\000\000\000\b1\b1\000\000\000\000\004Y\004Y\000\000\b1\004Y\004Y\b1\000\000\000\000\000\000\b1\000\000\b1\b1\007.\b1\000\000\000\000\000\000\000\000\001q\004Y\000\000\000\000\000\000\001q\025b\b1\001q\000\000\000\000\000\000\004Y\000\000\000\000\b1\b1\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\b1\000\000\000\000\001q\000\000\000\237\b1\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\006\245\000\000\000\000\000\000\000\000\006\245\000\237\000\000\006\245\000\000\000\241\000\000\000\000\000\000\000\000\000\000\000\241\000\237\006\245\000\000\000\000\000\000\006\245\000\000\006\245\000\241\000\000\000\000\000\241\000\000\000\000\000\000\000\000\000\241\000\241\000\238\006\245\000\000\000\000\000\000\000\000\000\000\006\245\000\000\000\000\000\000\000\000\000\000\000\000\000\241\000\000\006\245\000\000\000\241\006\245\000\000\000\000\000\000\000\000\006\245\006\245\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\006\245\000\000\000\000\000\000\006\245\000\000\000\000\000\000\000\000\000\241\000\000\006\201\006\201\000\000\006\245\006\245\016\166\000\000\006\245\006\245\000\241\005\249\000\000\000\000\000\000\000\000\005\249\000\000\000\000\005\249\006\201\006\201\006\201\000\000\000\000\006\245\017F\000\000\000\000\005\249\006\201\000\000\000\000\005\249\000\000\005\249\000\000\005a\007\002\000\000\000\000\000\000\005a\006\201\006\201\005a\000\000\005\249\006\201\000\000\006\201\006\201\006\201\005\249\000\000\005a\000\000\006\201\000\000\005a\000\000\005a\005\249\000\000\000\000\005\249\000\000\000\000\000\000\000\000\005\249\005\249\000\000\005a\006\201\000\000\000\000\000\000\000\000\005a\007n\000\000\000\000\000\000\000\000\000\000\005\249\000\000\000\000\000\000\005\249\005a\000\000\000\000\000\000\000\000\005a\005a\000\238\000\000\005\249\005\249\000\000\000\000\005\249\005\249\000\000\000\000\000\000\000\000\011\249\000\000\005a\000\000\000\000\011\249\000\000\004\202\011\249\000\000\000\000\005\249\000\000\000\000\000\000\000\000\005a\005a\011\249\000\000\005a\005a\011\249\000\000\011\249\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\249\005a\000\000\000\000\000\000\000\000\011\249\000\000\000\000\000\000\000\000\000\000\000\000\001\202\002b\011\249\000\000\002f\011\249\000\000\000\000\000\000\000\000\011\249\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\011\249\t\162\000\000\001\242\011\249\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\249\011\249\002n\002v\011\249\011\249\000\000\002\130\000\000\002\150\004\002\004\014\0041\000\000\000\000\000\000\020\214\0041\026>\004)\0041\011\249\000\000\000\000\004)\000\000\000\000\004)\000\000\000\000\0041\000\000\n\134\004\030\0041\000\000\0041\004)\000\000\000\000\000\000\004)\005j\004)\000\000\000\000\000\000\000\000\0041\000\000\000\000\000\000\026J\000\000\0041\004)\000\000\000\000\000\000\000\000\000\000\004)\000\000\0041\000\000\000\000\0041\000\000\000\000\020\234\004)\0041\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\0041\000\000\000\000\000\000\0041\004I\000\000\004)\000\000\000\000\004I\004)\004\025\004I\0041\0041\000\000\004\025\0041\0041\004\025\004)\004)\004I\000\000\004)\004)\004I\000\000\004I\004\025\000\000\000\000\000\000\004\025\0041\004\025\000\000\000\000\000\000\000\000\004I\004)\000\000\000\000\000\000\016\206\004I\004\025\000\000\000\000\000\000\000\000\019\186\004\025\000\000\004I\000\000\000\000\004I\000\000\000\000\000\000\004\025\004I\000\000\004\025\000\000\000\000\000\000\000\000\004\025\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004I\000\000\000\000\n\194\004I\000\000\000\000\004\025\000\000\001\202\001\206\004\025\000\000\000\000\004I\004I\000\000\000\000\004I\004I\000\000\004\025\004\025\002r\000\000\004\025\004\025\000\000\001\210\001\214\001\230\000\000\000\000\000\000\000\000\004I\000\000\000\000\001\242\000\000\000\000\000\000\004\025\000\000\000\000\001\250\020\154\006\205\006\205\000\000\000\000\001\246\002v\024\018\000\000\000\000\002\130\000\000\002\150\004\002\004\014\000\000\000\000\004\018\000\000\004\026\006\205\006\205\006\205\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\205\000\000\000\000\000\000\000\000\000\000\004\030\000\000\000\000\000\000\000\000\000\000\000\000\006\205\006\205\000\000\000\000\000\000\006\205\000\000\006\205\006\205\006\205\000\000\0049\000\000\000\000\006\205\000\000\0049\000\000\004!\0049\000\000\000\000\015n\004!\000\000\000\000\004!\000\000\000\000\0049\000\000\006\205\000\000\0049\000\000\0049\004!\000\000\000\000\000\000\004!\000\000\004!\000\000\000\000\000\000\000\000\0049\000\000\000\000\000\000\000\000\000\000\0049\004!\000\000\004Q\000\000\000\000\000\000\004!\004Q\000\000\000\000\004Q\0049\000\000\004\006\000\000\006\205\0049\000\000\004!\000\000\004Q\000\000\000\000\004!\004Q\000\000\004Q\000\000\000\000\000\000\000\000\000\000\0049\000\000\000\000\000\000\000\000\000\000\004Q\004!\000\000\000\000\000\000\000\000\004Q\000\000\0049\0049\000\000\000\000\0049\0049\000\000\004!\004!\000\000\004Q\004!\004!\000\000\000\000\004Q\011\014\000\000\000\000\000\000\000\000\0049\001\202\001\206\000\000\000\000\000\000\000\000\004!\000\000\000\000\004Q\017\246\000\000\000\000\000\000\000\000\000\000\003\226\020F\000\000\001\210\001\214\001\230\000\000\004Q\004Q\000\000\000\000\004Q\004Q\001\242\004m\000\000\000\000\000\000\000\000\000\246\000\000\000\000\002\166\000\000\000\000\000\000\001\246\002v\004Q\000\000\000\000\002\130\003\150\002\150\004\002\004\014\004m\000\000\003\154\020\194\004\026\007\149\000\000\000\000\007\149\000\000\000\000\000\000\000\000\000\000\003\158\000\000\000\000\000\000\000\000\000\000\016\146\004\030\000\000\000\000\007\149\007\149\000\000\007\149\007\149\024>\000\000\000\000\016\246\000\000\000\000\000\000\000\000\017\014\000\000\000\000\000\000\007m\000\000\000\000\007m\000\000\000\000\000\000\007\149\000\000\000\000\000\000\000\000\017\022\000\000\000\000\000\000\004R\000\000\004V\007m\007m\000\000\007m\007m\000\000\000\238\017*\017V\000\000\000\000\004m\004m\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007m\000\000\007\153\000\000\021~\007\153\000\000\000\000\000\000\000\000\000\000\000\000\007\149\000\000\007\149\000\000\000\000\000\000\007m\000\000\000\000\007\153\007\153\000\000\007\153\007\153\007\149\000\000\000\000\005\206\007\149\000\000\000\000\000\000\007\149\007\137\007\149\000\000\007\137\000\000\007\149\000\000\000\000\000\000\000\000\007\153\000\000\000\000\007m\000\000\007m\000\000\000\000\000\000\007\137\007\137\000\000\007\137\007\137\000\000\000\000\000\000\007m\000\238\000\000\005\206\007m\000\000\000\000\000\000\007m\000\000\007m\000\000\000\000\000\000\007m\000\000\007\137\000\000\r-\r-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\153\000\000\007\153\000\238\000\000\000\000\r-\r-\r-\007\022\000\000\000\000\000\000\000\000\007\153\000\000\r-\005\206\007\153\000\000\000\000\000\000\007\153\000\000\007\153\001\202\001\206\0222\007\153\r-\r-\000\000\000\000\007\137\r-\007\137\r-\r-\r-\000\000\000\000\000\000\000\000\r-\001\210\002\142\001\230\006\014\000\000\000\000\005\206\007\137\000\000\000\000\001\242\007\137\000\000\007\137\000\000\000\000\r-\007\137\000\000\001\202\001\206\022\146\000\000\001\246\002v\000\000\000\000\000\000\002\130\000\000\002\150\004\002\004\014\000\000\000\000\000\000\000\000\004\026\001\210\002\142\001\230\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\242\000\000\000\000\000\000\000\246\000\000\004\030\002\166\000\000\000\000\000\000\000\000\000\000\001\246\002v\000\000\000\000\004\141\002\130\000\000\002\150\004\002\004\014\003\154\000\000\000\000\000\000\004\026\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\158\000\000\000\000\000\000\000\000\000\000\016\146\000\000\000\000\004\030\000\000\000\000\000\000\000\000\000\000\024>\000\000\000\000\016\246\000\000\000\000\000\000\000\000\017\014\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\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\017*\017V\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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~"))
+ ((16, "C\170P\226Ff\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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[\\(\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\006\168\000\218\000\000\003\188\t|\000\000\001\208\003\232\nt\000\000\000\244\004\198\011l\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\220\000\000\000\000\000\000\0046T\016\000\000\000\000\000\000\005.\000\000\000\000\000\000\005\022\005\b\000\000\000\000T\016H\254\020X\021\178^\128\020X\\\142P\226\020XR,\000\000\007\168\000\000Dp\007\214\000\000C\146\000\000\027\158\000\000\000\000\004\246\000\000\005.\000\000\000\000\000\000\002J\000\000C\146\000\000\006&v\246]\160d\194\000\000\132l\134\028\000\000LP_\014\000\000X\\\026\206K\200\005.p\026FfC\170\000\000\000\000P\226\020XS\148Dp\007\012v\246\000\000\128\178FfC\170P\226\020X\000\000\000\000\016x\023\022\001N\b\004\000\000\002\138\b\022\000\000\000\000\000\000\000\000\000\000\020X\000\000A\206i\164C\170\000\000\000\000P\206\020XZ\024W\200\000\000\004\002\000\000\000\000\005\242\000\000\000\000H\166\004\002\024\138\003\130\0020\000\000\000\000\003\172\000\000\021\178\006\212\006\160\020X\028\254\020XC\170C\170\000\000M\\M\\\020X\028\254A\248\020X\000\000\000\000\000\000P\226\020X\000\000\000\248\000\000W\200y\188zJ\000\000\b\004\000\000\n\196\000\000\000\000A\214T\016\134h\000\000h\142\134h\000\000h\142h\142\000b\006:\0008\000\000\020\190\000\000\007b\000\000\000\000\b\198\000\000\000\000\000\000h\142\005.\000\000\000\000V\222T\016T\132_\014\000\000\000\000N*\000b\000\000\000\000_\014\007\162T\016\000\000O _\014P\022\000\000\000\000\000\000\011\190\000\000h\142\000\000\001\000\1310\000\000T\016\005\216T\016\000\000\022\\\b\150\005.\000\000\000\000\023\224\000\000\006\208\000\000Y\128\011\230\000\000\b\162h\142\012\182\000\000\012\222\000\000\007\200\000\000\000\000\004\184\000\000\000\000\000\000\021 4W\200P\206\020XW\200\000\000\000b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000M:\027v\000\000\000\000\000\000\001\244&\174t<\000\000\000\000P\206\020XW\200\000\000\000\000{hW\200\136.zJ\000\000\136v\000\000W\200\000\000\000\000X\180\000\000\000\000\000\000\n.\000\000\022\168\000\000\000\000z\214\000\000\136\208{\030\000\000\137\018\t\002\000\000\000\000z\214\000\000\004\024\000\000\000\000DHt\200\000\000\000\000\000\000Bn\023|\019\252\023\174\000\000\000\000\000\000\000\000\004\250\000\000\000\000Z\204\b\254\011F\000\017T\016\002\204\011\148\000\000\000\000\t\156\011F\006\172\000\000i\186P\234M\\\020X\028\254\000-\000\018\0020\000\000\n\240\021\178\021\178\000-\000\018\000\018\021\178\000\000jL\0050Dp\b\004\000\236\137`\000\000T\016ebT\016_ f\002T\016\000\144T\016f\156\000\000\000\000\020d\0008_\192\b\022\0008`\024\000\000j\230\0050\000\000\021\178k\128\000\000\b*\t\014`\184\000\000\000\000\000\000\000\000\000\000\000\000\001B\000\000\000\000\003\144\000\000\007r\028\254\000\000\\\192A\248\000\000\031\138\000\000\000\000\021\178\002\152\000\000\000\000\000\000\000\000[\132\000\000\001\200\000\000UP\001\130\005\"\000\000\0226V\170P\226\020XG,P\226\020X\016x\016x\000\000\000\000\000\000\000\000\001\240\024&B\188\000\000Q\150RJM\\\020X\028\254\b`\021\178\000\000\004*\000\000R\254S\178{\182I~T\016\002\128\000\000P\226\020X\000\000u\016\020Xy\188W\200E\178\000\000P\226\020Xw\\\004~\000\000W\200A\012T\016\003x\006\172\011\196\000\000\000\000\000\000H\166\003\138\003\138\000\000\012\154p\156\000\000P\206\020XW\200\025R\000\000P\226\020X\016x\0226\016x\002\232\023\240\000\000\000\000\016x\012\148\000\000\r\000\000\000\016x\003\224\rX\000\000'\166\000\000\b\196\000\000\000\000\026\022\000\000\017p\023.\000\000\000\000\000\000\000\000\b\020\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^\020XW\200ZJI\146\003\138\014,l\012W\200\000\000\000\000\000\000h\142\000\000\028\018\134\028\000\000\026\"T\016\029\220\r\198\000\000\000\000\000\000\000\000l\012\000\000\000\000\005\242\014\208\000\000B\170\000\000\000\000\135\176\000\000\bB\000\000\000\000K\200\003\138\014\140T\016\b`\000\000\000\000\007\006\005.\000\000T\016\n\146\000\000\000\000\014\244\000\000\000\000\000\000I\190T\016\0118\000\000\000\000\030*\000\000\000\000{\254\000\000\031\"|\138\000\000 \026|\210\000\000!\018\t\250\000\000\000\000\000\000\000\000\"\nW\200#\002p\234p\234\000\000\000\000\000\0001V\000\000\t\188\000\000\000\000\000\000q\140\000\000\000\000\002\138\023\248\000\000\b\226\000\000\000\000]bKl\000\000\000\000\n\180\000\000\000\000\000\000\rh\000\000\000\000\000\000\016x\004\216\024\232\000\000\t\218\000\000\005\208\000\0002N\000\000\012\142\000\000\006\200\000\0003F\000\000\015\138\007\192\000\0004>lt\000\000(\158\000\000\n\"\b\184\000\00056\000\000\r\178\t\176\000\0006.\000\000q\150\n\168\000\0007&\005\180\025\016\000\000\nX\011\160\000\0008\030\000\000\r\200\012\152\000\0009\022\000\000\r\172\r\144\000\000:\014\014\136\000\000;\006\015\128\019`\000\000\000\000\000\000\n\210\000\000\000\000\014`\000\000\000\000\015\156\000\000\011\002\000\000\000\000\000\000\015\028\000\000\015*\000\000\000\000J~\003\138\015\218p\156_\014\000b\000\000\000\000p\156\000\000\000\000\000\000p\156\000\000\015\208\000\000\000\000\000\000\000\000\000\000\000\000;\254W\200\000\000\000\000\016\014\000\000<\246\000\000=\238\000\000#\250\000\000\000\000\n\130\000\000\000\000W\200\000\000\000\000}j\011P\000\000\000\000G,\000\000\014\148\000\000\000\000V\020\000\000\014~\000\000\000\000\001\130\011\254\000\000\000\000\0226\022\028\b\004\000\000B>\000\000!,\023\176\021\220\000\000\000\000\014\002\000\000\000\000\001\238\025\030V\180\000\000\025\030\000\000\tX\000\000\000\000\014\142\000\000\000\000g>\t\004\004H\000\000\000\000\012H\000\000\000\000\014\192\000\000\000\000\000\000\020X\028\254\005\168\000\000\000\000\023&\003\130\0020\003\136\028\254w\228\021\178\001B\028\254xb\015\146\000\000\000\000\003\136\000\000H\232\019\248\021\204\000\000\007X\016\"\000\000\016$\000V_\014\006\196\000\000\016\n\015\170K\200\n|T\016\030\128\020F\r\018\004\248\000\000\031x\016\\\000\000\006\196\000\000\000\000\016\130_\014aX\000\000g\144_\014\016Z_\014m\012a\248\001N\016*\000\000\000\000\000\000\020X\128\252\000\000W\200p\234\000\000\000\000\016\156\000\000\000\000\000\000>\230\016\196y\188?\222h<\000\000\000\000HJ\000\000\005\128\000\000L\136\000\000\020X\000\000\021\178\006\026\000\000\128\178\000\000\020X\028\254\128\178\000\000\025D\023\022\001N\005.\130\144\021\178}\248p\234\000\000\005r\t\168\0020\003\136p\234\132\224\003\130\0020\003\136p\234\132\224\000\000\000\000\003\136p\234\000\000FfC\170W\200\027B\000\000\000\000FfC\170M\\\020X\028\254\128\178\000\000\020\182\000-\000[\015\240T\016\0120\016\190\131P\000\000p\234\000\000H\232\019\248\021\204x\186\023\228\0118~,\nZ\016\b\020Xp\234\000\000\020Xp\234\000\000h\142ff\019\134\002\222\001N\0008N\234\000\000\001N\0008N\234\000\000\025D\005r\n\160\0212\bZ\000\000N\234\000\000\0020\016\016\021\178p\234\134\222\003\130\0020\016 \021\178p\234\134\222\000\000\000\000\tX\000\000O\224\000\000\021\178\131\132N\234\000\000\b\242\000\000H\254\020X\021\178p\234\000\000H\232\019\248\021\204rFB\138\026\222\019\170\002\142\000\000\011vC\146\000\017\000\000\016\176\016b\024\196\020XT\184T\016\0120\000\000W\150\001N\005\204\r\216\000\000\n\024\000\000\016\188\016FT\016O(\000\000\0032\004\212\r\218\000\000\n\236\000\000\016\192\016JK\200\r\028T\016K\182O(\000\000UP\020X\024\196\016\232\011\028\001N\000\000\014\012\024\196T\016\012\208\000b\000\000T\016\n$\n\218\000\000\000\000mf\000\000\000\000\014b\024\196m\228O(\000\000\020XT\016\012\226T\016V\\O(\000\000\014\144\000\000\000\000O(\000\000\000\000W\150\000\000p\234\132\238\019\170\002\142\011v\016\218\016\140\024\196p\234\132\238\000\000\000\000\019\170\002\142\011v\016\230\016\138M\252LZ_\014\017\016M\252h\142\020\184\017\030M\252_\014\017 M\252n\132o\004\000\000\129\140\000\000\000\000p\234\134\236\019\170\002\142\011v\017\022\016\162M\252p\234\134\236\000\000\000\000\000\000ff\000\000\000\000\000\000\000\000\000\000\000\000N\234\000\000\133\128\020XDp\017 v\246\000\000\128\178\133\128\000\000\000\000\1358\020XDp\017*\016\188]\160\135\176\006\196\017l\000\000\000\000o\130rF\020X\000\000~\200\021\204\000\000\000\000\128\178\1358\000\000\000\000\000\000y6D\228I\154\006\196\017v\000\000\000\000\000\000rF\020X\000\000\006\196\017z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014\168B\138\019\170\002\142\011v\017Xr\182\023\204\020XZ\024j\190\020(\001N\006\196\017Z\011l\000\000\000\000\017\b\000\000\000\000a\152\000\000\007\188\r\230\000\000\r\140\000\000\017`\016\244T\016d\240\017r\011\150\000\000\000\000\017\"\000\000\000\000\020F\0032\014\210\000\000\017~s8\137\172\003\138\017\028T\016\014 \000\000\000\000\017<\000\000\000\000\000\000a\152\000\000\0070\014\246\000\000\r\212\000\000\017\168\0176K\200\000\000\017\180s\186\137\248\003\138\017RT\016\015\024\000\000\000\000\017d\000\000\000\000\000\000\020X\000\000a\152\000\000\020z\020X\023\204\023\204u\168Ff\020X\128\252W\200\021\162\000\000\012V\001N\000\000\014\220\023\204T\016\014\186\b\004\000\000\020XW\200r\182\023\204\rh\023\204\000\000D\142Et\000\000bR\000\000\000\000b\238\000\000\000\000c\138\000\000\014\238\023\204d&\128\252W\200\021\162\000\000\000\"\000\000\000\000M\252\r\026\000\000\000\000d.\017\186\000\000a\152\000\000\023\204d.a\152\000\000\020XT\016a\152\000\000\015\136\000\000\000\000a\152\000\000\000\000j\190\000\000\129\192M\252\017r\023\204\130\\r\182\000\000p\234\133\142\019\170\002\142\011v\017\210r\182p\234\133\142\000\000\000\000\000\000\135\248P\206\000\000\000\000\000\000\000\000\000\000\000\000\132\022p\234\000\000\133\128\000\000\000\000\000\000\000\000p\234\135\248\000\000\018\014\000\000\000\000\132\022\018\020\000\000p\234\135\248\000\000\000\000\015\222\000\000\000\000i4\0032\000\000\000\000DH\000\000T\016\015\n\000\000j\190\015\240\000\000\000\000\000\000\015\156\000\000\000\000\000\000M\\\020X\028\254\006\178\000\000Z8\000\000\007p\000\000\000*\000\000\000\000\0184\000\000\018\\y\188\000\000@\214\018@\000\000\000\000\0182\026R\028B\021\204v0\023\228\020X\000\000\128\178\000\000\000\000\000\000\000\000\000\000\000\000\000\000v8\023\228\020X\000\000\015\190v\246\000\000\128\178\000\000\0184\026R\028B\128\178\000\000\018H\000\000\000\238\014\140\020X`\226\000\000\000\000\028\190y\242\000\000\000\000\017\214\000\000\018.T\016\000\000\015\170\012\166\000b\000\000\000\000T\016\004R\006B\000\000T\016\012\018\006\196\018\\\000\000\000\000\127\"\000\000\000\000]\160\000\000\128\178\000\000\018V\026R\029:N\234\000\000\000\000\000\000\000\000\015\214\127\188]\160\000\000\128\178\000\000\018`\026R\029:N\234\000\000\016\026\000\000\000\000\b\n\000\000p\234\000\000\018t\000\000\000\000\017\230\000\000\017\236\000\000\017\252\000\000\000\000\\\142\018\000\000\000\000\000%\182\\(\018\158\000\000\000\000\000\000\014z\011D]\232\018\164\000\000\000\000\000\000\000\000\000\000\000\000\018\022\000\000\023\228\000\000\018\030\000\000T\016\000\000\t\b\000\000\000\000\018 \000\000\000\000\0008\000\000\003\210\000\000\000\000\000\000\001\214\000\000\016\030\000\000\0180\000\000W\200\022\168\000\000\000\000\012<\018H\000\000\000\000\018B\r$G,\005.\128:\000\000\000\000\000\000\000\000\000\000YL\000\000\000\000\018\234\000\000\138<\000\000\016p\018\236\000\000\018\238\000\000G\224G\224[\190[\190\000\000\000\000p\234[\190\000\000\000\000\000\000p\234[\190\018Z\000\000\018f\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\158\002\246\t)\023\158\t)\t)\t)\025F\t)\t)\t)\001\210\004A\004A\004F\002\250\t)\003>\003B\t\242\t)\001\206\t)\023\162\003F\000\238\002\254\025J\t)\t)\003\214\003\218\t)\003\222\0032\003\234\003\242\006\214\007\018\t)\t)\002\178\001\206\006\242\003:\t)\t)\t)\b\026\b\030\b*\b>\001*\005v\t)\t)\t)\t)\t)\t)\t)\t)\t)\b\178\000\238\t)\015\154\t)\t)\003\145\b\190\b\214\t*\005\130\005\134\t)\t)\t)\r\190\t)\t)\t)\t)\002j\002\154\r\238\t)\006\178\t)\t)\0035\t)\t)\t)\t)\t)\t)\005\138\b2\t)\t)\t)\bJ\004r\t>\0035\t)\t)\t)\t)\012\245\012\245\023\166\n\206\004\154\012\245\n\218\012\245\012\245\000\238\012\245\012\245\012\245\012\245\004A\012\245\012\245\001f\012\245\012\245\012\245\003i\012\245\012\245\012\245\012\245\004A\012\245\015\250\012\245\012\245\012\245\012\245\012\245\012\245\012\245\012\245\007\190\007\030\007R\012\245\004\226\012\245\012\245\012\245\012\245\012\245\004A\012\245\012\245\004A\012\245\003\238\012\245\012\245\012\245\000\238\007\194\012\245\012\245\012\245\012\245\012\245\012\245\012\245\000\238\012\245\012\245\012\245\012\245\012\245\012\245\012\245\012\245\012\245\012\245\012\245\004A\012\245\012\245\007\138\012\245\012\245\001j\004A\007.\004A\012\245\012\245\012\245\012\245\012\245\004A\012\245\012\245\012\245\012\245\012\245\000\238\012\245\012\245\0076\012\245\012\245\000\238\012\245\012\245\012\245\012\245\012\245\012\245\012\245\012\245\012\245\012\245\012\245\012\245\012\245\b\"\004A\012\245\012\245\012\245\012\245\001\181\001\181\001\181\001f\015Z\001\181\003i\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\015\006\001\181\007\222\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\003\134\003\138\001\181\000\238\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\006\246\001\181\001\181\001\181\b\022\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\002f\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\027\187\001\181\001\181\018\142\007\250\007\030\007n\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\014\202\bb\001\181\005\186\001\181\001\181\007\254\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\n]\n]\002\225\007\138\r\025\n]\003\149\n]\n]\000\238\n]\n]\n]\n]\001\186\n]\n]\r\025\n]\n]\n]\000\238\n]\n]\n]\n]\002j\n]\000\n\n]\n]\n]\n]\n]\n]\n]\n]\024\222\007\030\b\174\n]\004A\n]\n]\n]\n]\n]\000\238\n]\n]\012\"\n]\003\018\n]\n]\n]\002\225\024\226\n]\n]\n]\n]\n]\n]\n]\004A\n]\n]\n]\n]\n]\n]\n]\n]\n]\n]\n]\003\149\n]\n]\007\138\n]\n]\004A\004A\007\030\004A\n]\n]\n]\n]\n]\004\001\n]\n]\n]\n]\tV\000\238\t\134\n]\005\241\n]\n]\007\202\n]\n]\n]\n]\n]\n]\n]\n]\n]\n]\n]\n]\n]\003\146\n]\n]\n]\n]\n]\003\173\003\173\001r\007\138\006\242\003\173\t\022\003\173\003\173\000\238\003\173\003\173\003\173\003\173\000\238\003\173\003\173\006\137\003\173\003\173\003\173\000\238\003\173\003\173\003\173\003\173\001\130\003\173\006Z\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\006\137\007\030\004\001\003\173\004B\003\173\003\173\003\173\003\173\003\173\015J\003\173\003\173\006^\003\173\t\005\003\173\003\173\003\173\005\241\b\146\003\173\003\173\003\173\003\173\003\173\003\173\003\173\015R\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\b\213\tN\t~\007\138\003\173\003\173\003\150\003^\b\230\027\171\003\173\003\173\003\173\003\173\003\173\004R\003\173\003\173\003\173\003\173\tV\000\238\t\134\003\173\b\"\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\018\250\b\234\t\006\003\161\005R\003\161\003\161\t\005\003\161\003\161\003\161\003\161\001\146\003\161\003\161\006\154\003\161\003\161\003\161\002N\003\161\003\161\003\161\003\161\019\002\003\161\001\198\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\006\237\b\213\004A\003\161\002R\003\161\003\161\003\161\003\161\003\161\b\029\003\161\003\161\001\218\003\161\007\"\003\161\003\161\003\161\006\237\004A\003\161\003\161\003\161\003\161\003\161\003\161\003\161\004A\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\000\238\tN\t~\001\234\003\161\003\161\004A\004A\007\030\007^\003\161\003\161\003\161\003\161\003\161\001\222\003\161\003\161\003\161\003\161\tV\004A\t\134\003\161\004r\003\161\003\161\016v\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\006\237\003\161\003\161\003\161\003\161\003\161\t\217\t\217\018\206\007\138\b&\t\217\006\158\t\217\t\217\001\238\t\217\t\217\t\217\t\217\000\238\t\217\t\217\006\149\t\217\t\217\t\217\000\238\t\217\t\217\t\217\t\217\004A\t\217\007\222\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\006\149\007\030\018\214\t\217\000\238\t\217\t\217\t\217\t\217\t\217\005\217\t\217\t\217\001\206\t\217\012\130\t\217\t\217\t\217\0152\016\146\t\217\t\217\t\217\t\217\t\217\t\217\t\217\000\238\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\026N\t\217\t\217\007\138\t\217\t\217\r\002\003j\003\018\004A\t\217\t\217\t\217\t\217\t\217\002v\t\217\t\217\t\217\t\217\t\217\000\238\t\217\t\217\004B\t\217\t\217\003n\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\000\238\004A\t\217\t\217\t\217\t\217\t\209\t\209\004\242\001f\003i\t\209\007\005\t\209\t\209\025.\t\209\t\209\t\209\t\209\003\158\t\209\t\209\003\162\t\209\t\209\t\209\003\137\t\209\t\209\t\209\t\209\b\241\t\209\004^\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\007\222\026R\015\162\t\209\001\206\t\209\t\209\t\209\t\209\t\209\005\209\t\209\t\209\000\238\t\209\012\154\t\209\t\209\t\209\022\130\011Z\t\209\t\209\t\209\t\209\t\209\t\209\t\209\000\238\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\006\210\t\209\t\209\022\138\t\209\t\209\002\214\004V\007\030\b\241\t\209\t\209\t\209\t\209\t\209\002\142\t\209\t\209\t\209\t\209\t\209\0252\t\209\t\209\b\021\t\209\t\209\025>\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\012\185\b\241\t\209\t\209\t\209\t\209\t\225\t\225\021\246\007\138\007\210\t\225\011b\t\225\t\225\006\242\t\225\t\225\t\225\t\225\012\185\t\225\t\225\012\189\t\225\t\225\t\225\000\238\t\225\t\225\t\225\t\225\005F\t\225\004\174\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\012\189\007\030\021\254\t\225\002\190\t\225\t\225\t\225\t\225\t\225\005\209\t\225\t\225\003\022\t\225\012\174\t\225\t\225\t\225\015\138\026\226\t\225\t\225\t\225\t\225\t\225\t\225\t\225\0112\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\017\242\t\225\t\225\007\138\t\225\t\225\003\n\001\206\0116\005J\t\225\t\225\t\225\t\225\t\225\003\026\t\225\t\225\t\225\t\225\t\225\000\238\t\225\t\225\004B\t\225\t\225\002&\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\t\190\004\214\t\225\t\225\t\225\t\225\t\193\t\193\000\238\0022\007\222\t\193\t\146\t\193\t\193\005\002\t\193\t\193\t\193\t\193\004V\t\193\t\193\000\238\t\193\t\193\t\193\012.\t\193\t\193\t\193\t\193\t\150\t\193\007\154\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\006F\t\001\n\162\t\193\0122\t\193\t\193\t\193\t\193\t\193\011N\t\193\t\193\007\158\t\193\012\206\t\193\t\193\t\193\004b\014\254\t\193\t\193\t\193\t\193\t\193\t\193\t\193\b\134\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\006\242\t\193\t\193\014\226\t\193\t\193\006\170\006\194\001\002\001\190\t\193\t\193\t\193\t\193\t\193\001\222\t\193\t\193\t\193\t\193\t\193\006U\t\193\t\193\000\238\t\193\t\193\005.\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\006U\t\001\t\193\t\193\t\193\t\193\t\201\t\201\003\134\003\138\006\242\t\201\012\006\t\201\t\201\027\139\t\201\t\201\t\201\t\201\018B\t\201\t\201\016\218\t\201\t\201\t\201\012z\t\201\t\201\t\201\t\201\001v\t\201\012\n\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\011\202\006\202\016F\t\201\012~\t\201\t\201\t\201\t\201\t\201\0186\t\201\t\201\014\230\t\201\012\226\t\201\t\201\t\201\018\218\t\146\t\201\t\201\t\201\t\201\t\201\t\201\t\201\018B\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\012\202\t\201\t\201\b\193\t\201\t\201\006\026\012.\001\002\001\190\t\201\t\201\t\201\t\201\t\201\003\022\t\201\t\201\t\201\t\201\t\201\006]\t\201\t\201\005\221\t\201\t\201\r\014\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\006]\000\238\t\201\t\201\t\201\t\201\n\001\n\001\003\134\017\234\011Z\n\001\012J\n\001\n\001\017\146\n\001\n\001\n\001\n\001\004\014\n\001\n\001\017\254\n\001\n\001\n\001\012z\n\001\n\001\n\001\n\001\001\134\n\001\012N\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\004\018\019\006\b\193\n\001\rf\n\001\n\001\n\001\n\001\n\001\b\189\n\001\n\001\000\238\n\001\012\246\n\001\n\001\n\001\r\134\0142\n\001\n\001\n\001\n\001\n\001\n\001\n\001\004A\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\015\182\n\001\n\001\011j\n\001\n\001\b!\014N\007\158\000\238\n\001\n\001\n\001\n\001\n\001\002\142\n\001\n\001\n\001\n\001\n\001\006e\n\001\n\001\014:\n\001\n\001\014R\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\006e\000\238\n\001\n\001\n\001\n\001\t\241\t\241\027F\001\222\006\174\t\241\b\189\t\241\t\241\000\238\t\241\t\241\t\241\t\241\006\190\t\241\t\241\r\138\t\241\t\241\t\241\006\254\t\241\t\241\t\241\t\241\001\150\t\241\002\253\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\004\210\t\002\011\142\t\241\018\150\t\241\t\241\t\241\t\241\t\241\014\134\t\241\t\241\019>\t\241\r\018\t\241\t\241\t\241\011\018\005&\t\241\t\241\t\241\t\241\t\241\t\241\t\241\021\214\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\b\217\t\241\t\241\n\206\t\241\t\241\n\218\015\014\002\190\022\030\t\241\t\241\t\241\t\241\t\241\018\190\t\241\t\241\t\241\t\241\t\241\004A\t\241\t\241\n\206\t\241\t\241\n\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\000\238\012\146\t\241\t\241\t\241\t\241\t\233\t\233\001\002\001\190\014\138\t\233\004\214\t\233\t\233\000\238\t\233\t\233\t\233\t\233\001\206\t\233\t\233\012\150\t\233\t\233\t\233\t\"\t\233\t\233\t\233\t\233\b\237\t\233\000\238\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\0056\b\217\017^\t\233\015\018\t\233\t\233\t\233\t\233\t\233\tj\t\233\t\233\019V\t\233\r&\t\233\t\233\t\233\002\154\005>\t\233\t\233\t\233\t\233\t\233\t\233\t\233\023\174\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\003\022\t\233\t\233\015\198\t\233\t\233\023\022\003}\023\178\0266\t\233\t\233\t\233\t\233\t\233\011Z\t\233\t\233\t\233\t\233\t\233\000\238\t\233\t\233\tr\t\233\t\233\012Z\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\001\002\001\190\t\233\t\233\t\233\t\233\t\249\t\249\022\002\012^\019\158\t\249\004\214\t\249\t\249\019^\t\249\t\249\t\249\t\249\012Z\t\249\t\249\012\006\t\249\t\249\t\249\t\130\t\249\t\249\t\249\t\249\004\214\t\249\012J\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\r6\022\142\012\222\t\249\019\026\t\249\t\249\t\249\t\249\t\249\005\213\t\249\t\249\r\"\t\249\r:\t\249\t\249\t\249\023J\014\190\t\249\t\249\t\249\t\249\t\249\t\249\t\249\018\254\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\018\210\t\249\t\249\014\194\t\249\t\249\b\025\021\250\005\225\b%\t\249\t\249\t\249\t\249\t\249\r!\t\249\t\249\t\249\t\249\t\249\n\186\t\249\t\249\n\162\t\249\t\249\012\146\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\n\242\014v\t\249\t\249\t\249\t\249\nI\nI\rr\014\238\019\178\nI\014b\nI\nI\000\238\nI\nI\nI\nI\019J\nI\nI\014z\nI\nI\nI\025\250\nI\nI\nI\nI\014\242\nI\015\026\nI\nI\nI\nI\nI\nI\nI\nI\007n\007\241\022^\nI\004B\nI\nI\nI\nI\nI\023.\nI\nI\015\030\nI\rF\nI\nI\nI\011\022\019\130\nI\nI\nI\nI\nI\nI\nI\022>\nI\nI\nI\nI\nI\nI\nI\nI\nI\nI\nI\000\238\nI\nI\007n\nI\nI\022\134\004\213\024\246\b\021\nI\nI\nI\nI\nI\027B\nI\nI\nI\nI\nI\019\182\nI\nI\011F\nI\nI\r-\nI\nI\nI\nI\nI\nI\nI\nI\nI\nI\nI\nI\nI\023\"\014f\nI\nI\nI\nI\003\157\003\157\000\238\023\130\023\238\003\157\019^\003\157\003\157\000\238\003\157\003\157\003\157\003\157\025\018\003\157\003\157\007n\003\157\003\157\003\157\011v\003\157\003\157\003\157\003\157\007n\003\157\012\170\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\r~\001\206\022\190\003\157\0262\003\157\003\157\003\157\003\157\003\157\024\206\003\157\003\157\001\206\003\157\r\150\003\157\003\157\003\157\025\002\r\158\003\157\003\157\003\157\003\157\003\157\003\157\003\157\r\178\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\026\214\tN\t~\025\198\003\157\003\157\r\226\014\014\015f\002\006\003\157\003\157\003\157\003\157\003\157\026\170\003\157\003\157\003\157\003\157\tV\023\242\t\134\003\157\015\142\003\157\003\157\003\254\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\015\170\003\157\003\157\003\157\003\157\003\157\001\237\001\237\026B\025\022\001\222\001\237\015\174\002\190\001\237\015\214\002\130\001\237\tf\001\237\004Y\002\246\001\237\024\210\001\237\001\237\001\237\015\234\001\237\001\237\001\237\001\210\025\006\tn\016\002\002\250\001\237\001\237\001\237\001\237\001\237\tv\001\237\016\022\016B\016V\002\254\017V\001\237\001\237\001\237\001\237\001\237\026\218\0032\001\190\017b\001\237\006\022\001\237\001\237\002\178\002\226\018\006\003:\001\237\001\237\001\237\b\026\b\030\b*\018\030\012f\005v\001\237\001\237\001\237\001\237\001\237\001\237\001\237\001\237\001\237\018\166\tN\t~\018\170\001\237\001\237\018\226\018\230\019\014\019\018\005\130\005\134\001\237\001\237\001\237\019:\001\237\001\237\001\237\001\237\012n\019\230\012\190\001\237\019\234\001\237\001\237\020\014\001\237\001\237\001\237\001\237\001\237\001\237\005\138\b2\001\237\001\237\001\237\bJ\004r\020\018\020\"\001\237\001\237\001\237\001\237\n1\n1\0202\020>\020r\n1\020v\002\190\n1\020\194\002\130\n1\n1\n1\020\234\002\246\n1\020\238\n1\n1\n1\020\254\n1\n1\n1\001\210\021N\n1\021n\002\250\n1\n1\n1\n1\n1\n1\n1\021\174\021\210\021\226\002\254\022\n\n1\n1\n1\n1\n1\022\014\0032\001\190\022\026\n1\022*\n1\n1\002\178\022F\022V\003:\n1\n1\n1\b\026\b\030\b*\022j\n1\005v\n1\n1\n1\n1\n1\n1\n1\n1\n1\022\150\n1\n1\022\154\n1\n1\022\166\022\182\022\202\023\190\005\130\005\134\n1\n1\n1\024\022\n1\n1\n1\n1\n1\024>\n1\n1\024\166\n1\n1\024\182\n1\n1\n1\n1\n1\n1\005\138\b2\n1\n1\n1\bJ\004r\025R\025Z\n1\n1\n1\n1\n-\n-\025j\025v\025\218\n-\025\238\002\190\n-\026\030\002\130\n-\n-\n-\026&\002\246\n-\026b\n-\n-\n-\026\138\n-\n-\n-\001\210\026\194\n-\026\242\002\250\n-\n-\n-\n-\n-\n-\n-\026\254\027\006\027\015\002\254\027\031\n-\n-\n-\n-\n-\0272\0032\001\190\027N\n-\027k\n-\n-\002\178\027{\027\151\003:\n-\n-\n-\b\026\b\030\b*\027\203\n-\005v\n-\n-\n-\n-\n-\n-\n-\n-\n-\027\231\n-\n-\027\242\n-\n-\028'\028;\028C\028\127\005\130\005\134\n-\n-\n-\028\135\n-\n-\n-\n-\n-\000\000\n-\n-\000\000\n-\n-\000\000\n-\n-\n-\n-\n-\n-\005\138\b2\n-\n-\n-\bJ\004r\000\000\000\000\n-\n-\n-\n-\0029\0029\000\000\000\000\000\000\0029\000\000\002\190\0029\000\000\002\130\0029\tf\0029\000\000\002\246\0029\000\000\0029\0029\0029\000\000\0029\0029\0029\001\210\002\225\tn\000\000\002\250\0029\0029\0029\0029\0029\tv\0029\000\000\000\000\000\000\002\254\004A\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\b\026\b\030\b*\000\000\012f\005v\0029\0029\0029\0029\0029\0029\0029\0029\0029\000\000\004\173\0029\002\225\0029\0029\004A\006\130\002\190\004A\005\130\005\134\0029\0029\0029\000\000\0029\0029\0029\0029\000\000\000\238\004A\0029\004\173\0029\0029\004A\0029\0029\0029\0029\0029\0029\005\138\b2\0029\0029\0029\bJ\004r\000\000\004A\0029\0029\0029\0029\004A\007\030\004A\003\n\004A\004A\004A\004A\004A\004A\004A\017\186\004A\000\238\004A\004A\000\000\004A\004A\004A\016\134\004A\004A\004A\004A\004A\004A\004A\004A\004A\000\000\004A\004A\000\000\000\000\004A\004A\000\238\004A\004A\004A\004A\004A\007\138\004A\004A\004A\004A\004A\004A\004A\004A\000\238\004A\004A\004A\004A\004A\004A\004A\004A\000\238\004A\004A\004A\004A\004A\004A\004A\004A\b\189\004N\004A\000\000\000\000\004A\004A\004A\000\238\004A\000\n\000\000\004A\004A\004A\004A\004A\004A\004A\004A\004A\000\000\021\198\004A\004A\002\225\002\225\007f\004A\004B\006\233\000\000\004A\004A\000\000\007n\016\138\0226\002\225\000\238\004A\004A\004A\007r\000\000\004A\004A\004A\004A\006\233\000\161\004A\000\161\006\233\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\000\000\161\022\234\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\189\000\000\000\161\000\161\005\141\000\161\000\161\000\161\000\238\000\161\b\241\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\000\b\138\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\233\000\161\015\130\t\029\000\161\002\130\000\161\001\210\000\161\005\141\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\017\238\t\029\005\141\000\222\000\000\007\002\001\222\000\161\000\000\002\226\000\000\014\150\002\178\000\161\000\161\000\161\000\161\000\000\015\134\000\161\000\161\000\161\000\161\002)\002)\004Y\000\000\003\n\002)\000\000\002\190\002)\015\146\002\130\002)\001b\002)\000\000\002\246\002)\007\006\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\169\002)\002)\002)\002)\002)\004Y\0032\b.\000\000\002)\000\000\002)\002)\002\178\000\000\006\"\003:\002)\002)\002)\b\026\b\030\b*\tN\t~\005v\002)\002)\002)\002)\002)\002)\002)\002)\002)\006&\tN\t~\b\169\002)\002)\000\000\tV\000\000\t\134\005\130\005\134\002)\002)\002)\000\000\002)\002)\002)\002)\tV\000\000\t\134\002)\b\169\002)\002)\000\000\002)\002)\002)\002)\002)\002)\005\138\b2\002)\002)\002)\bJ\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\169\002E\000\000\002E\004\254\000\000\002E\b\169\002E\002E\002E\000\n\002E\002E\002E\000\000\027\215\000\000\000\000\000\n\002E\002E\002E\002E\002E\000\000\002E\002\225\006*\004\169\000\000\005\234\002E\002E\002E\002E\002E\000\000\0066\002\225\000\000\002E\006B\002E\002E\000\000\000\000\002\225\006~\002E\002E\002E\004\169\000\000\006\213\t\025\000\000\000\000\002E\002E\002E\002E\002E\002E\002E\002E\002E\000\000\tN\t~\000\000\002E\002E\006\134\014\174\000\000\002\190\006\213\t\025\002E\002E\002E\000\000\002E\002E\002E\002E\tV\002\190\t\134\002E\002\130\002E\002E\001\210\002E\002E\002E\002E\002E\002E\b\165\000\000\002E\002E\002E\000\000\021\182\000\000\000\000\002E\002E\002E\002E\002A\002A\000\000\022\242\003\n\002A\022\246\003\022\002A\000\000\002\178\002A\000\000\002A\000\000\017\134\002A\023&\002A\002A\002A\tZ\002A\002A\002A\012&\b\165\000\000\000\000\015\146\002A\002A\002A\002A\002A\rj\002A\rv\000\000\012B\0236\012R\002A\002A\002A\002A\002A\b\165\bf\001\190\001*\002A\000\000\002A\002A\005\134\002\225\002\225\014V\002A\002A\002A\014j\014~\014\142\000\000\000\000\000\000\002A\002A\002A\002A\002A\002A\002A\002A\002A\000\000\tN\t~\b\165\002A\002A\000\n\004\254\000\000\001\206\b\165\000\000\002A\002A\002A\000\000\002A\002A\002A\002A\tV\000\000\t\134\002A\000\000\002A\002A\001\210\002A\002A\002A\002A\002A\002A\002\225\000\000\002A\002A\002A\000\000\018\174\000\000\000\000\002A\002A\002A\002A\002-\002-\000\000\000\000\002\154\002-\0196\003\022\002-\000\000\002\178\002-\000\000\002-\000\000\000\000\002-\019N\002-\002-\002-\012r\002-\002-\002-\002\225\002\225\016\178\000\000\000\000\002-\002-\002-\002-\002-\012\138\002-\012\162\000\000\000\000\002\225\r\006\002-\002-\002-\002-\002-\000\000\bf\014\206\000\000\002-\000\n\002-\002-\r\026\000\000\r.\014V\002-\002-\002-\014j\014~\014\142\000\000\000\000\000\000\002-\002-\002-\002-\002-\002-\002-\002-\002-\000\000\tN\t~\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-\tV\000\000\t\134\002-\000\000\002-\002-\000\000\002-\002-\002-\002-\002-\002-\000\000\000\000\002-\002-\002-\000\000\t:\000\000\000\000\002-\002-\002-\002-\002=\002=\000\000\000\000\000\000\002=\012}\006*\002=\000\000\005\234\002=\000\000\002=\000\000\000\000\002=\0066\002=\002=\002=\006B\002=\002=\002=\012}\012}\000\000\000\000\012}\002=\002=\002=\002=\002=\000\000\002=\b\021\000\000\000\000\b\021\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>\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\021\002=\000\000\002=\002=\000\000\000\000\000\000\000\000\000\000\000\000\002=\002=\002=\b\021\002=\002=\002=\002=\012}\000\000\004\253\002=\000\000\002=\002=\002\225\t\158\002=\002=\002=\002=\002=\004\253\n\230\002=\002=\002=\000\000\000\000\b\021\000\000\002=\002=\002=\002=\t%\t%\000\000\000\000\000\000\t%\000\000\000\000\t%\000\n\000\000\t%\000\000\t%\000\000\000\000\t\202\004\253\t%\t\238\t%\b\021\t%\t%\t%\002\225\000\000\000\000\000\000\017\"\n\002\n\026\n\"\n\n\n*\000\000\t%\002\225\002\225\000\000\000\000\000\000\t%\t%\n2\n:\t%\004\253\007\245\000\000\004\253\t%\000\000\nB\t%\000\000\000\000\000\000\000\000\t%\t%\000\238\000\000\000\000\000\000\000\000\000\000\002\246\t%\t%\t\210\n\018\nJ\nR\nb\t%\t%\002\166\012\193\t%\000\000\t%\nj\000\000\003Z\000\000\000\000\000\238\000\000\t%\t%\nr\000\000\t%\t%\t%\t%\003f\012\193\000\000\t%\000\000\t%\t%\002B\n\146\t%\n\154\nZ\t%\t%\000\000\000\000\t%\nz\t%\000\000\002F\000\000\005v\t%\t%\n\130\n\138\002q\002q\000\000\000\000\000\000\002q\012\133\006*\002q\000\000\005\234\002q\000\000\002q\000\000\005\130\002q\0066\002q\002q\002q\006B\002q\002q\002q\012\133\012\133\000\000\000\000\012\133\002q\002q\002q\002q\002q\000\000\002q\015\130\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\t\210\002q\002q\002q\002q\002q\002q\000\000\015\134\002q\000\000\002q\002q\000\000\000\000\000\000\000\000\000\000\000\000\002q\002q\002q\015\146\002q\002q\002q\002q\012\133\000\000\001\206\002q\000\000\002q\002q\000\000\002q\002q\002q\002q\002q\002q\026\014\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~\002Y\002Y\002Y\001\210\000\000\000\000\000\000\000\000\002Y\002Y\002Y\002Y\002Y\000\000\002Y\015\130\000\000\000\000\002\130\000\000\002Y\002Y\002Y\002Y\002Y\004\154\003\202\000\000\004\217\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\t\210\002Y\002Y\002Y\002Y\002Y\002Y\000\000\015\134\002Y\000\000\002Y\002Y\006\234\000\000\000\000\000\000\000\000\000\000\002Y\002Y\002Y\015\146\002Y\002Y\002Y\002Y\000\000\000\000\000\000\002Y\000\000\002Y\002Y\000\000\002Y\002Y\002Y\002Y\002Y\002Y\012\129\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\129\012\129\002e\000\000\012\129\002e\000\000\002e\000\000\000\000\t\202\000\000\002e\002e\002e\021\026\002e\002e\002e\000\000\000\000\000\000\000\000\000\000\002e\002e\002e\n\n\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\t\210\n\018\002e\002e\002e\002e\002e\000\000\012\129\002e\000\000\002e\002e\000\000\000\000\000\000\000\000\000\238\b\t\002e\002e\002e\b\t\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\154\000\000\000\000\002e\002e\002e\002e\002u\002u\000\000\000\000\000\000\002u\b\t\011\162\002u\000\000\011\174\002u\000\000\002u\000\000\000\000\002u\011\186\002u\002u\002u\011\198\002u\002u\002u\000\000\000\000\b\t\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\t\210\002u\002u\002u\002u\002u\002u\000\000\007\234\002u\000\000\002u\002u\000\000\000\000\000\000\000\000\000\238\b\005\002u\002u\002u\b\005\002u\002u\002u\002u\000\000\007\238\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\165\000\000\000\000\002u\002u\002u\002u\002U\002U\007\222\000\000\000\000\002U\b\005\007\165\002U\000\000\005\234\002U\000\000\002U\000\000\000\238\002U\007\165\002U\002U\002U\007\165\002U\002U\002U\000\000\000\000\b\005\000\000\000\000\002U\002U\002U\002U\002U\000\000\002U\000\000\000\000\006\253\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\006\253\002U\002U\002U\006\253\007\242\004\254\000\000\000\000\000\000\002U\002U\t\210\002U\002U\002U\002U\002U\002U\000\000\000\000\002U\000\000\002U\002U\000\000\000\000\000\000\000\000\007\189\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\189\000\000\000\000\002U\002U\002U\002U\002a\002a\000\000\000\000\000\000\002a\005f\007\189\002a\000\000\005\234\002a\000\000\002a\000\000\000\000\t\202\007\189\002a\002a\002a\007\189\002a\002a\002a\000\000\000\000\000\000\000\000\000\000\002a\002a\002a\n\n\002a\000\000\002a\000\000\000\000\006\237\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\237\002a\002a\002a\006\237\000\000\000\000\000\000\000\000\000\000\002a\002a\t\210\n\018\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\217\000\000\000\000\002a\002a\002a\002a\002]\002]\000\000\000\000\000\000\002]\b&\006*\002]\000\000\005\234\002]\000\000\002]\000\000\000\000\t\202\007\217\002]\002]\002]\007\217\002]\002]\002]\000\000\000\000\000\000\000\000\000\000\002]\002]\002]\n\n\002]\000\000\002]\000\000\000\000\000\000\000\000\000\000\002]\002]\002]\002]\002]\000\000\000\000\000\000\000\000\002]\000\000\002]\002]\000\000\000\000\000\000\000\000\002]\002]\002]\000\000\000\000\000\000\000\000\000\000\000\000\002]\002]\t\210\n\018\002]\002]\002]\002]\002]\000\000\000\000\002]\000\000\002]\002]\000\000\000\000\000\000\000\000\007\209\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\209\000\000\000\000\002]\002]\002]\002]\002\133\002\133\000\000\000\000\000\000\002\133\000\000\011\222\002\133\000\000\007\209\002\133\000\000\002\133\000\000\000\000\t\202\007\209\002\133\002\133\002\133\007\209\002\133\002\133\002\133\000\000\000\000\000\000\000\000\000\000\n\002\n\026\n\"\n\n\n*\000\000\002\133\000\000\000\000\000\000\000\000\000\000\002\133\002\133\n2\n:\002\133\000\000\000\000\000\000\000\000\002\133\000\000\nB\002\133\000\000\000\000\000\000\000\000\002\133\002\133\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\133\002\133\t\210\n\018\nJ\nR\nb\002\133\002\133\000\000\000\000\002\133\000\000\002\133\nj\000\000\000\000\000\000\000\000\000\238\000\000\002\133\002\133\nr\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\nZ\002\133\002\133\000\000\000\000\002\133\nz\002\133\000\000\007\161\000\000\000\000\002\133\002\133\n\130\n\138\002m\002m\000\000\000\000\000\000\002m\000\000\007\161\002m\000\000\005\234\002m\000\000\002m\000\000\000\000\t\202\007\161\002m\002m\002m\007\161\002m\002m\002m\000\000\000\000\000\000\000\000\000\000\002m\002m\002m\n\n\002m\000\000\002m\000\000\000\000\000\000\000\000\000\000\002m\002m\002m\002m\002m\000\000\000\000\000\000\000\000\002m\000\000\002m\002m\000\000\000\000\000\000\000\000\002m\002m\002m\000\000\000\000\000\000\000\000\000\000\000\000\002m\002m\t\210\n\018\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\014&\000\000\000\000\002m\002m\002m\002m\002i\002i\000\000\000\000\000\000\002i\000\000\011\162\002i\000\000\011\174\002i\000\000\002i\000\000\000\000\t\202\011\186\002i\002i\002i\011\198\002i\002i\002i\000\000\000\000\000\000\000\000\000\000\002i\002i\002i\n\n\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\t\210\n\018\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\t\202\000\000\002}\002}\002}\000\000\002}\002}\002}\000\000\000\000\000\000\000\000\000\000\n\002\n\026\n\"\n\n\002}\000\000\002}\000\000\000\000\000\000\000\000\000\000\002}\002}\n2\n:\002}\000\000\027*\001\222\000\000\002}\000\000\002}\002}\000\000\000\000\000\000\000\000\002}\002}\000\238\015\146\000\000\000\000\000\000\000\000\000\000\002}\002}\t\210\n\018\nJ\nR\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}\nZ\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\t\202\000\000\002Q\002Q\002Q\000\000\002Q\002Q\002Q\000\000\000\000\000\000\000\000\000\000\002Q\002Q\002Q\n\n\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\006N\000\000\004\002\000\000\000\000\000\000\002Q\002Q\t\210\n\018\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\t\202\000\000\002M\002M\002M\000\000\002M\002M\002M\000\000\000\000\000\000\000\000\000\000\n\002\n\026\n\"\n\n\002M\000\000\002M\000\000\000\000\000\000\000\000\000\000\002M\002M\n2\n:\002M\000\000\t\138\003\n\000\000\002M\000\000\002M\002M\000\000\000\000\000\000\000\000\002M\002M\000\238\011\254\000\000\012\014\000\000\000\000\000\000\002M\002M\t\210\n\018\nJ\nR\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\nZ\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\t\202\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\002\n\026\n\"\n\n\002\169\000\000\002\169\000\000\000\000\000\000\000\000\000\000\002\169\002\169\n2\n:\002\169\000\000\012\194\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\012\214\000\000\012\234\000\000\000\000\000\000\002\169\002\169\t\210\n\018\nJ\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\nZ\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\t\202\000\000\002I\002I\002I\000\000\002I\002I\002I\000\000\000\000\000\000\000\000\000\000\n\002\n\026\n\"\n\n\002I\000\000\002I\000\000\000\000\000\000\000\000\000\000\002I\002I\n2\n:\002I\000\000\000\000\000\000\000\000\002I\000\000\002I\002I\000\000\000\000\000\000\000\000\002I\002I\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002I\002I\t\210\n\018\nJ\nR\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\nZ\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\t\202\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\002\n\026\n\"\n\n\002\129\000\000\002\129\000\000\000\000\000\000\000\000\000\000\002\129\002\129\n2\n:\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\t\210\n\018\nJ\nR\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\nZ\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\t\202\000\000\002y\002y\002y\000\000\002y\002y\002y\000\000\000\000\000\000\000\000\000\000\n\002\n\026\n\"\n\n\002y\000\000\002y\000\000\000\000\000\000\000\000\000\000\002y\002y\n2\n:\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\t\210\n\018\nJ\nR\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\nZ\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\t\202\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\002\n\026\n\"\n\n\n*\000\000\002\137\000\000\000\000\000\000\000\000\000\000\002\137\002\137\n2\n:\002\137\000\000\000\000\000\000\000\000\002\137\000\000\nB\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\t\210\n\018\nJ\nR\nb\002\137\002\137\000\000\000\000\002\137\000\000\002\137\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\137\002\137\nr\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\nZ\002\137\002\137\000\000\000\000\002\137\nz\002\137\000\000\000\000\000\000\000\000\002\137\002\137\n\130\n\138\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\t\202\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\002\n\026\n\"\n\n\002\141\000\000\002\141\000\000\000\000\000\000\000\000\000\000\002\141\002\141\n2\n:\002\141\000\000\000\000\000\000\000\000\002\141\000\000\nB\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\t\210\n\018\nJ\nR\nb\002\141\002\141\000\000\000\000\002\141\000\000\002\141\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\141\002\141\nr\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\nZ\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\130\n\138\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\t\202\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\002\n\026\n\"\n\n\002\145\000\000\002\145\000\000\000\000\000\000\000\000\000\000\002\145\002\145\n2\n:\002\145\000\000\000\000\000\000\000\000\002\145\000\000\nB\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\t\210\n\018\nJ\nR\nb\002\145\002\145\000\000\000\000\002\145\000\000\002\145\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\145\002\145\nr\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\nZ\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\130\n\138\b\225\b\225\000\000\000\000\000\000\b\225\000\000\000\000\b\225\000\000\000\000\b\225\000\000\b\225\000\000\000\000\t\202\000\000\b\225\b\225\b\225\000\000\b\225\b\225\b\225\000\000\000\000\000\000\000\000\000\000\n\002\n\026\n\"\n\n\n*\000\000\b\225\000\000\000\000\000\000\000\000\000\000\b\225\b\225\n2\n:\b\225\000\000\000\000\000\000\000\000\b\225\000\000\nB\b\225\000\000\000\000\000\000\000\000\b\225\b\225\000\238\000\000\000\000\000\000\000\000\000\000\000\000\b\225\b\225\t\210\n\018\nJ\nR\nb\b\225\b\225\000\000\000\000\b\225\000\000\b\225\nj\000\000\000\000\000\000\000\000\000\000\000\000\b\225\b\225\nr\000\000\b\225\b\225\b\225\b\225\000\000\000\000\000\000\b\225\000\000\b\225\b\225\000\000\b\225\b\225\b\225\nZ\b\225\b\225\000\000\000\000\b\225\nz\b\225\000\000\000\000\000\000\000\000\b\225\b\225\n\130\n\138\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\t\202\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\002\n\026\n\"\n\n\n*\000\000\002\149\000\000\000\000\000\000\000\000\000\000\002\149\002\149\n2\n:\002\149\000\000\000\000\000\000\000\000\002\149\000\000\nB\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\t\210\n\018\nJ\nR\nb\002\149\002\149\000\000\000\000\002\149\000\000\002\149\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\149\002\149\nr\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\146\002\149\n\154\nZ\002\149\002\149\000\000\000\000\002\149\nz\002\149\000\000\000\000\000\000\000\000\002\149\002\149\n\130\n\138\b\221\b\221\000\000\000\000\000\000\b\221\000\000\000\000\b\221\000\000\000\000\b\221\000\000\b\221\000\000\000\000\t\202\000\000\b\221\b\221\b\221\000\000\b\221\b\221\b\221\000\000\000\000\000\000\000\000\000\000\n\002\n\026\n\"\n\n\n*\000\000\b\221\000\000\000\000\000\000\000\000\000\000\b\221\b\221\n2\n:\b\221\000\000\000\000\000\000\000\000\b\221\000\000\nB\b\221\000\000\000\000\000\000\000\000\b\221\b\221\000\238\000\000\000\000\000\000\000\000\000\000\000\000\b\221\b\221\t\210\n\018\nJ\nR\nb\b\221\b\221\000\000\000\000\b\221\000\000\b\221\nj\000\000\000\000\000\000\000\000\000\000\000\000\b\221\b\221\nr\000\000\b\221\b\221\b\221\b\221\000\000\000\000\000\000\b\221\000\000\b\221\b\221\000\000\b\221\b\221\b\221\nZ\b\221\b\221\000\000\000\000\b\221\nz\b\221\000\000\000\000\000\000\000\000\b\221\b\221\n\130\n\138\002\197\002\197\000\000\000\000\000\000\002\197\000\000\000\000\002\197\000\000\000\000\002\197\000\000\002\197\000\000\000\000\t\202\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\002\n\026\n\"\n\n\n*\000\000\002\197\000\000\000\000\000\000\000\000\000\000\002\197\002\197\n2\n:\002\197\000\000\000\000\000\000\000\000\002\197\000\000\nB\002\197\000\000\000\000\000\000\000\000\002\197\002\197\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\197\002\197\t\210\n\018\nJ\nR\nb\002\197\002\197\000\000\000\000\002\197\000\000\002\197\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\197\002\197\nr\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\146\002\197\n\154\nZ\002\197\002\197\000\000\000\000\002\197\nz\002\197\000\000\000\000\000\000\000\000\002\197\002\197\n\130\n\138\002\193\002\193\000\000\000\000\000\000\002\193\000\000\000\000\002\193\000\000\000\000\002\193\000\000\002\193\000\000\000\000\t\202\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\002\n\026\n\"\n\n\n*\000\000\002\193\000\000\000\000\000\000\000\000\000\000\002\193\002\193\n2\n:\002\193\000\000\000\000\000\000\000\000\002\193\000\000\nB\002\193\000\000\000\000\000\000\000\000\002\193\002\193\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\193\002\193\t\210\n\018\nJ\nR\nb\002\193\002\193\000\000\000\000\002\193\000\000\002\193\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\193\002\193\nr\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\146\002\193\n\154\nZ\002\193\002\193\000\000\000\000\002\193\nz\002\193\000\000\000\000\000\000\000\000\002\193\002\193\n\130\n\138\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\t\202\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\002\n\026\n\"\n\n\n*\000\000\002\201\000\000\000\000\000\000\000\000\000\000\002\201\002\201\n2\n:\002\201\000\000\000\000\000\000\000\000\002\201\000\000\nB\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\t\210\n\018\nJ\nR\nb\002\201\002\201\000\000\000\000\002\201\000\000\002\201\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\201\002\201\nr\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\146\002\201\n\154\nZ\002\201\002\201\000\000\000\000\002\201\nz\002\201\000\000\000\000\000\000\000\000\002\201\002\201\n\130\n\138\002\181\002\181\000\000\000\000\000\000\002\181\000\000\000\000\002\181\000\000\000\000\002\181\000\000\002\181\000\000\000\000\t\202\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\002\n\026\n\"\n\n\n*\000\000\002\181\000\000\000\000\000\000\000\000\000\000\002\181\002\181\n2\n:\002\181\000\000\000\000\000\000\000\000\002\181\000\000\nB\002\181\000\000\000\000\000\000\000\000\002\181\002\181\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\181\002\181\t\210\n\018\nJ\nR\nb\002\181\002\181\000\000\000\000\002\181\000\000\002\181\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\181\002\181\nr\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\146\002\181\n\154\nZ\002\181\002\181\000\000\000\000\002\181\nz\002\181\000\000\000\000\000\000\000\000\002\181\002\181\n\130\n\138\002\185\002\185\000\000\000\000\000\000\002\185\000\000\000\000\002\185\000\000\000\000\002\185\000\000\002\185\000\000\000\000\t\202\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\002\n\026\n\"\n\n\n*\000\000\002\185\000\000\000\000\000\000\000\000\000\000\002\185\002\185\n2\n:\002\185\000\000\000\000\000\000\000\000\002\185\000\000\nB\002\185\000\000\000\000\000\000\000\000\002\185\002\185\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\185\002\185\t\210\n\018\nJ\nR\nb\002\185\002\185\000\000\000\000\002\185\000\000\002\185\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\185\002\185\nr\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\146\002\185\n\154\nZ\002\185\002\185\000\000\000\000\002\185\nz\002\185\000\000\000\000\000\000\000\000\002\185\002\185\n\130\n\138\002\189\002\189\000\000\000\000\000\000\002\189\000\000\000\000\002\189\000\000\000\000\002\189\000\000\002\189\000\000\000\000\t\202\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\002\n\026\n\"\n\n\n*\000\000\002\189\000\000\000\000\000\000\000\000\000\000\002\189\002\189\n2\n:\002\189\000\000\000\000\000\000\000\000\002\189\000\000\nB\002\189\000\000\000\000\000\000\000\000\002\189\002\189\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\189\002\189\t\210\n\018\nJ\nR\nb\002\189\002\189\000\000\000\000\002\189\000\000\002\189\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\189\002\189\nr\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\146\002\189\n\154\nZ\002\189\002\189\000\000\000\000\002\189\nz\002\189\000\000\000\000\000\000\000\000\002\189\002\189\n\130\n\138\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\t\202\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\002\n\026\n\"\n\n\n*\000\000\002\209\000\000\000\000\000\000\000\000\000\000\002\209\002\209\n2\n:\002\209\000\000\000\000\000\000\000\000\002\209\000\000\nB\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\t\210\n\018\nJ\nR\nb\002\209\002\209\000\000\000\000\002\209\000\000\002\209\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\209\002\209\nr\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\146\002\209\n\154\nZ\002\209\002\209\000\000\000\000\002\209\nz\002\209\000\000\000\000\000\000\000\000\002\209\002\209\n\130\n\138\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\t\202\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\002\n\026\n\"\n\n\n*\000\000\002\205\000\000\000\000\000\000\000\000\000\000\002\205\002\205\n2\n:\002\205\000\000\000\000\000\000\000\000\002\205\000\000\nB\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\t\210\n\018\nJ\nR\nb\002\205\002\205\000\000\000\000\002\205\000\000\002\205\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\205\002\205\nr\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\146\002\205\n\154\nZ\002\205\002\205\000\000\000\000\002\205\nz\002\205\000\000\000\000\000\000\000\000\002\205\002\205\n\130\n\138\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\t\202\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\002\n\026\n\"\n\n\n*\000\000\002\213\000\000\000\000\000\000\000\000\000\000\002\213\002\213\n2\n:\002\213\000\000\000\000\000\000\000\000\002\213\000\000\nB\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\t\210\n\018\nJ\nR\nb\002\213\002\213\000\000\000\000\002\213\000\000\002\213\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\213\002\213\nr\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\146\002\213\n\154\nZ\002\213\002\213\000\000\000\000\002\213\nz\002\213\000\000\000\000\000\000\000\000\002\213\002\213\n\130\n\138\002\177\002\177\000\000\000\000\000\000\002\177\000\000\000\000\002\177\000\000\000\000\002\177\000\000\002\177\000\000\000\000\t\202\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\002\n\026\n\"\n\n\n*\000\000\002\177\000\000\000\000\000\000\000\000\000\000\002\177\002\177\n2\n:\002\177\000\000\000\000\000\000\000\000\002\177\000\000\nB\002\177\000\000\000\000\000\000\000\000\002\177\002\177\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\177\002\177\t\210\n\018\nJ\nR\nb\002\177\002\177\000\000\000\000\002\177\000\000\002\177\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\177\002\177\nr\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\146\002\177\n\154\nZ\002\177\002\177\000\000\000\000\002\177\nz\002\177\000\000\000\000\000\000\000\000\002\177\002\177\n\130\n\138\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\r\254\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\t\202\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\n\002\n\026\n\"\n\n\n*\000\000\002\029\000\000\000\000\000\000\000\000\000\000\002\029\002\029\n2\n:\002\029\000\000\000\000\000\000\000\000\002\029\000\000\nB\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\t\210\n\018\nJ\nR\nb\002\029\002\029\000\000\000\000\002\029\000\000\002\029\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\029\002\029\nr\000\000\002\029\002\029\014\022\002\029\000\000\000\000\000\000\002\029\000\000\002\029\002\029\000\000\n\146\002\029\n\154\nZ\002\029\002\029\000\000\000\000\002\029\nz\002\029\000\000\000\000\000\000\000\000\002\029\002\029\n\130\n\138\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\t\202\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\n\002\n\026\n\"\n\n\n*\000\000\002\025\000\000\000\000\000\000\000\000\000\000\002\025\002\025\n2\n:\002\025\000\000\000\000\000\000\000\000\002\025\000\000\nB\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\t\210\n\018\nJ\nR\nb\002\025\002\025\000\000\000\000\002\025\000\000\002\025\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\025\002\025\nr\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\146\002\025\n\154\nZ\002\025\002\025\000\000\000\000\002\025\nz\002\025\000\000\000\000\000\000\000\000\002\025\002\025\n\130\n\138\002\173\002\173\000\000\000\000\000\000\002\173\000\000\000\000\002\173\000\000\000\000\002\173\000\000\002\173\000\000\000\000\t\202\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\002\n\026\n\"\n\n\n*\000\000\002\173\000\000\000\000\000\000\000\000\000\000\002\173\002\173\n2\n:\002\173\000\000\000\000\000\000\000\000\002\173\000\000\nB\002\173\000\000\000\000\000\000\000\000\002\173\002\173\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\173\002\173\t\210\n\018\nJ\nR\nb\002\173\002\173\000\000\000\000\002\173\000\000\002\173\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\173\002\173\nr\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\146\002\173\n\154\nZ\002\173\002\173\000\000\000\000\002\173\nz\002\173\000\000\000\000\000\000\000\000\002\173\002\173\n\130\n\138\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\r\254\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\000\000\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\003\253\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\r\254\000\000\000\000\003\253\000\000\002\017\002\017\002\017\002\017\001\006\000\000\000\006\000\000\006\229\000\000\002\186\002\190\006*\002\234\002\130\005\234\b\242\000\000\000\000\002\246\001\n\000\000\0066\000\000\002\142\000\000\006B\006\229\000\000\001\210\003\206\006\229\002\190\0036\001\018\bn\br\001\030\001\"\003\170\000\000\000\000\003F\000\000\002\254\007\226\025\030\000\000\b\150\b\154\001\210\003\222\0032\003\234\b\158\006\214\000\000\001:\000\000\002\178\007\r\000\000\003:\000\000\000\000\000\000\b\026\b\030\b*\b>\000\000\005v\000\000\003\202\001>\001B\001F\001J\001N\007\r\002\178\b\178\001R\007\r\007\001\000\000\001V\000\000\b\190\b\214\t*\005\130\005\134\000\000\000\000\001Z\000\000\000\000\000\000\006\229\000\000\001^\002\225\007\001\000\000\000\000\018\130\007\001\006\234\000\000\000\000\001\154\011\018\000\000\011\030\005\138\b2\004\026\001\158\000\000\014F\004r\t>\001\006\001\166\000\006\001\170\001\174\000\000\002\186\002\190\000\n\002\234\002\130\011\"\000\000\000\000\000\000\002\246\001\n\000\000\000\000\000\000\bj\000\000\000\238\000\000\002\225\001\210\000\000\000\000\007\r\0036\001\018\bn\br\001\030\001\"\000\000\002\225\002\225\003F\000\000\002\254\000\000\bv\n\206\b\150\b\154\n\218\003\222\0032\003\234\b\158\006\214\000\238\001:\000\000\002\178\000\000\000\000\003:\000\000\000\000\000\000\b\026\b\030\b*\b>\006*\005v\000\000\005\234\001>\001B\001F\001J\001N\000\000\0066\b\178\001R\000\000\006B\000\000\001V\000\000\b\190\b\214\t*\005\130\005\134\000\000\000\000\001Z\000\000\000\000\000\000\000\000\006*\001^\000\000\005\234\011&\000\000\000\000\000\000\000\000\000\000\0066\001\154\006\022\000\000\006B\005\138\b2\012\181\001\158\000\000\014F\004r\t>\004m\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\181\002\246\000\000\002\030\003\178\000\000\002\"\000\000\004m\000\000\003\182\001\210\000\000\017\026\000\000\002\250\000\000\003>\003B\002.\000\000\000\000\003\186\000\000\003F\000\000\002\254\000\000\016\174\000\000\003\214\003\218\000\000\003\222\0032\003\234\003\242\006\214\000\000\000\000\017\018\002\178\000\000\000\000\003:\017*\002:\000\000\b\026\b\030\b*\b>\000\000\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0172\000\000\b\178\000\000\t\r\000\000\000\000\000\000\000\000\b\190\b\214\t*\005\130\005\134\017F\017r\000\000\000\000\004m\004m\000\000\000\000\000\000\006f\024\234\000\000\t\r\000\000\000\000\002>\012\181\012\161\000\000\000\000\017\174\021\154\005\138\b2\025\n\000\173\000\000\bJ\004r\t>\000\173\000\000\002\190\000\173\000\000\002\130\012\181\tf\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\tn\000\000\002\250\002.\000\000\000\000\0026\012\161\tv\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\130\000\173\000\000\002\130\000\173\002\178\000\000\002:\003:\000\173\000\173\000\173\b\026\b\030\b*\000\000\012f\005v\000\173\000\173\006*\021B\000\000\005\234\024\238\000\173\000\000\000\000\t\r\000\173\0066\000\000\000\000\000\000\006B\000\000\000\000\005\130\005\134\000\173\000\173\015\134\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\146\000\000\021f\000\000\000\173\000\173\005\138\b2\000\000\000\000\000\197\bJ\004r\000\000\000\173\000\197\000\173\002\190\000\197\000\000\002\130\000\000\tf\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\021r\tn\000\000\002\250\000\000\000\000\000\000\000\000\b\210\tv\000\197\000\000\000\000\000\000\002\254\000\000\000\197\021\006\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\b\026\b\030\b*\000\000\012f\005v\000\197\000\197\000\000\000\000\000\000\000\000\r\234\000\197\000\000\000\000\000\000\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\238\000\197\000\197\000\000\000\000\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\b2\000\000\000\000\000\000\bJ\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:\006*\000\000\000>\005\234\000\000\000\000\000B\000\000\000\000\000\000\0066\000\000\000\000\000F\006B\000\000\000\000\000\000\000\000\000J\000\000\000N\000R\000V\000Z\000^\000b\000f\000\000\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\000\000\000\000\000\000\000\000\000\000\000z\000\000\000\000\000~\000\130\000\000\000\000\000\000\000\000\000\000\000\134\000\138\000\142\000\000\000\000\000\000\000\000\000\000\000\146\000\150\000\154\000\158\000\000\000\162\000\166\000\170\000\000\000\000\000\000\000\174\000\178\000\182\000\000\000\000\000\000\000\186\000\006\000\190\000\194\000\246\002\186\002\190\002\194\002\234\002\130\000\198\000\000\000\202\000\000\002\246\000\000\000\000\004\141\000\206\000\210\000\000\000\214\000\000\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\174\000\000\003\214\003\218\000\000\003\222\0032\003\234\003\242\006\214\000\000\000\000\017\018\002\178\000\000\000\000\003:\017*\000\000\000\000\b\026\b\030\b*\b>\000\000\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0172\000\000\b\178\000\000\027\250\000\000\000\000\000\000\000\000\b\190\b\214\t*\005\130\005\134\017F\017r\000\000\000\006\028\027\014\218\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\028J\000\000\021\154\005\138\b2\014Z\003\182\001\210\bJ\004r\t>\002\250\000\000\003>\003B\000\000\000\000\000\000\003\186\000\000\003F\000\000\002\254\000\000\016\174\000\000\003\214\003\218\000\000\003\222\0032\003\234\003\242\006\214\000\000\016n\017\018\002\178\000\000\000\000\003:\017*\002\006\000\000\b\026\b\030\b*\b>\000\000\005v\000\000\000\000\002\n\000\000\000\000\000\000\000\000\0172\000\000\b\178\001\210\027\250\000\000\000\000\000\000\000\000\b\190\b\214\t*\005\130\005\134\017F\017r\000\000\000\000\004\149\000\000\003\154\000\000\000\000\000\000\001\006\000\000\007\002\001\222\000\000\000\000\003V\002\190\t\018\002\178\002\130\021\154\005\138\b2\000\000\002\246\001\n\bJ\004r\t>\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\007\006\000\000\000\000\002\225\000\000\003z\002\225\001.\011\014\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\011\018\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\n\178\002\225\002\130\015\130\000\000\000\000\002\130\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.\011\014\000\000\000\000\003r\001\190\0016\007\173\015\134\001:\000\000\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005j\015\146\005v\021F\000\000\001>\001B\001F\001J\001N\000\000\000\000\000\000\001R\005z\000\000\007\173\001V\n\181\000\000\000\000\000\000\005\130\005\134\000\000\005\202\001Z\005\134\000\000\000\000\007\173\000\000\001^\007\173\b\166\000\000\000\000\021R\000\000\000\000\007\173\000\000\001\154\011\018\007\173\000\000\005\138\000\000\n\181\001\158\000\000\001\162\004r\001\006\021\006\001\166\000\000\001\170\001\174\003V\002\190\r\170\n\181\002\130\000\000\n\181\011\134\000\000\002\246\001\n\000\000\000\000\n\181\002\142\000\000\000\000\n\181\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.\011\014\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\011\018\000\000\000\000\005\138\000\000\000\000\001\158\000\000\001\162\004r\000\000\b\249\001\166\000\006\001\170\001\174\000\000\002\186\002\190\000\000\002\234\002\130\000\000\000\000\000\000\000\000\002\246\000\000\000\000\000\000\000\000\b\249\000\000\b\249\b\249\000\000\001\210\000\000\000\000\000\000\002\250\000\000\003>\003B\000\000\000\000\000\000\000\000\b\001\003F\000\000\002\254\000\000\b\001\000\000\003\214\003\218\n\222\003\222\0032\003\234\003\242\006\214\001\202\001\206\011>\002\178\000\000\000\000\003:\000\000\000\000\b\001\b\026\b\030\b*\b>\000\000\005v\000\000\000\000\000\000\001\210\002\170\001\230\000\000\000\000\000\000\b\178\000\000\000\000\000\000\001\242\000\000\b\001\b\190\b\214\t*\005\130\005\134\000\000\000\000\b\001\000\000\000\000\001\246\002\146\b\001\b\001\000\238\002\158\000\000\002\178\004\030\004*\000\000\b\001\b\001\000\000\0046\000\000\000\000\005\138\b2\b\249\004\253\004\253\bJ\004r\t>\004\253\000\000\004\253\004\253\000\000\004\253\004:\004\253\004\253\b\001\000\000\004\253\b\001\004\253\004\253\004\253\004\253\004\253\004\253\004\253\004\253\b\001\004\253\016~\004\253\000\000\000\000\000\000\000\000\000\000\002\006\004\253\000\000\000\000\000\000\000\000\004\253\004\253\004\253\000\000\002\n\004\253\004\253\004\253\004\253\000\000\004\253\000\000\001\210\004\253\000\000\000\000\000\000\000\000\004\253\004\253\004\253\000\000\000\000\004\253\004\253\004\253\000\000\004\253\004\253\003\154\000\000\000\000\000\000\000\000\004\253\007\002\001\222\000\000\004\253\004\253\000\000\004\253\002\178\004\253\000\000\000\000\000\000\000\000\004\253\004\253\004\253\000\000\004\253\004\253\004\253\004\253\000\000\004\253\004\253\000\000\000\000\000\000\004\253\000\000\004\253\004\253\000\000\000\000\002\150\004\253\007\006\000\000\000\000\020\026\004\253\000\000\n\205\000\000\004\253\n\205\004\253\004\253\n\205\n\205\000\000\004\253\n\205\000\000\n\205\000\000\000\000\n\205\000\000\001*\000\000\n\205\n\205\000\000\n\205\n\205\002\225\n\205\000\000\n\205\000\000\000\000\000\000\002\225\n\205\000\000\000\000\n\205\000\000\000\000\000\000\000\000\000\000\000\000\002\225\n\205\000\000\n\205\000\000\000\000\n\205\n\205\000\n\000\000\000\000\000\000\000\000\n\205\000\000\000\000\n\205\000\000\000\000\n\205\n\205\000\000\n\205\002\225\n\205\n\205\000\000\000\000\000\000\000\000\002\225\000\000\000\000\000\000\000\000\000\000\002\225\n\205\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\205\n\205\000\000\000\000\n\205\000\000\n\205\000\000\000\000\000\000\000\000\005\166\000\000\002\225\000\000\000\000\001\202\001\206\n\205\n\205\000\000\n\205\n\205\000\000\n\205\000\000\n\205\000\000\n\205\000\000\n\205\000\000\n\205\b\229\b\229\001\210\001\214\001\230\b\229\000\000\001\206\b\229\000\000\000\000\000\000\001\242\003\190\000\000\018\174\b\229\000\000\b\229\b\229\b\229\000\000\b\229\b\229\b\229\001\246\020\022\000\000\0196\000\000\002\158\000\000\002\178\004\030\004*\000\000\b\229\000\000\000\000\020&\000\000\000\000\b\229\b\229\000\000\000\000\b\229\000\000\000\000\002\154\000\000\b\229\000\000\000\000\b\229\000\000\004:\000\000\000\000\b\229\b\229\b\229\000\000\000\000\000\000\000\000\000\000\000\000\b\229\b\229\000\000\000\000\000\000\000\000\000\000\b\229\000\000\000\000\000\000\004\154\000\000\000\000\b\229\000\000\000\000\000\000\000\000\000\000\000\000\b\229\b\229\b\229\000\000\b\229\b\229\000\000\004Y\000\000\000\000\000\000\000\000\004Y\000\000\b\229\004Y\b\229\b\229\000\000\000\000\000\000\b\229\000\000\000\000\000\000\004Y\b\229\000\000\000\000\004Y\b\229\004Y\b\229\b\229\012u\012u\000\000\000\000\004Y\012u\000\000\001\206\012u\004Y\000\000\000\000\000\000\000\000\000\000\004Y\004\186\000\000\012u\012u\012u\004B\012u\012u\012u\000\000\000\000\004Y\004Y\000\000\000\000\000\000\004Y\002\226\000\000\000\000\012u\000\000\000\000\000\000\000\000\000\000\012u\012u\000\000\000\000\012u\000\000\004Y\002\154\004Y\012u\000\000\000\000\012u\000\000\000\000\000\000\004Y\012u\012u\012u\004Y\004Y\002\226\000\238\004Y\004Y\012u\012u\000\000\000\000\004R\004Y\000\000\012u\000\000\000\000\000\000\004\154\000\000\000\000\012u\004Y\000\000\000\000\000\000\000\000\021\026\012u\012u\012u\000\000\012u\012u\000\000\004Y\000\000\004Y\000\000\000\000\004Y\000\000\012u\004Y\012u\012u\004Y\000\000\000\000\012u\000\000\000\000\000\000\004Y\012u\000\000\000\000\004Y\012u\004Y\012u\012u\b\233\b\233\000\000\000\000\000\000\b\233\000\000\001\206\b\233\004Y\000\000\000\000\000\000\000\000\000\000\004Y\b\233\000\000\b\233\b\233\b\233\000\000\b\233\b\233\b\233\000\000\000\000\004Y\000\000\000\000\000\000\000\000\004Y\002\226\000\000\000\000\b\233\000\000\000\000\000\000\000\000\000\000\b\233\b\233\000\000\000\000\b\233\000\000\004Y\002\154\000\000\b\233\000\000\000\000\b\233\000\000\000\000\000\000\000\000\b\233\b\233\b\233\004Y\004Y\000\000\000\000\004Y\004Y\b\233\b\233\000\000\000\000\007n\000\000\000\000\b\233\000\000\000\000\000\000\004\154\000\000\000\000\b\233\004Y\000\000\000\000\000\000\000\000\000\000\b\233\b\233\b\233\002\225\b\233\b\233\000\000\000\000\002\225\002\225\002\225\000\000\000\000\002\225\b\233\002\225\b\233\b\233\002\225\002\225\002\225\b\233\002\225\002\225\002\225\002\225\b\233\002\225\002\225\000\000\b\233\002\225\b\233\b\233\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\000\000\002\225\002\225\000\n\002\225\002\225\002\225\000\000\000\000\000\000\002\225\002\225\000\000\002\225\002\225\002\225\002\225\002\225\002\225\000\000\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\000\000\002\225\000\000\000\000\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\000\000\006\141\000\000\0009\002\225\002\225\000\000\0009\0009\000\000\0009\0009\002\225\000\000\000\000\000\000\0009\000\000\002\225\000\000\000\000\006\141\002\225\002\225\000\000\000\000\0009\002\225\002\225\002\225\0009\006\222\0009\0009\000\000\000\000\000\000\000\000\000\000\0009\000\000\0009\000\000\000\000\000\000\0009\0009\000\000\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\181\012\161\000\000\0009\0009\0009\0009\0009\000\000\006\137\000\000\0005\000\000\000\000\000\000\0005\0005\000\000\0005\0005\012\181\000\000\000\000\002\030\0005\000\000\002\"\000\000\000\000\006\137\0009\0009\000\000\002*\0005\0009\0009\0009\0005\002.\0005\0005\0026\012\161\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\153\000\000\012=\000\000\000\000\000\000\012=\012=\000\000\012=\012=\002>\000\000\000\000\000\000\012=\000\000\000\000\000\000\000\000\006\153\0005\0005\000\000\000\000\012=\0005\0005\0005\012=\000\000\012=\012=\000\000\000\000\000\000\000\000\000\000\012=\000\000\012=\000\000\000\000\000\000\012=\012=\000\000\012=\012=\012=\012=\012=\000\000\000\000\000\000\012=\000\000\000\000\012=\000\000\000\000\000\000\012=\012=\012=\012=\000\000\012=\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\012\181\012\161\000\000\012=\012=\012=\012=\012=\000\000\006\149\000\000\0129\000\000\000\000\000\000\0129\0129\000\000\0129\0129\012\181\000\000\000\000\002\030\0129\000\000\002\"\000\000\000\000\006\149\012=\012=\000\000\002\206\0129\012=\012=\012=\0129\002.\0129\0129\0026\012\161\000\000\000\000\000\000\0129\000\000\0129\000\000\000\000\000\000\0129\0129\000\000\0129\0129\0129\0129\0129\000\000\001\202\001\206\0129\000\000\002:\0129\000\000\000\000\000\000\0129\0129\0129\0129\000\000\0129\000\000\000\000\000\000\000\000\001\210\001\214\001\230\000\000\000\000\0129\000\000\000\000\000\000\000\000\001\242\000\000\0129\0129\0129\0129\0129\001\250\000\000\000\000\000\000\000\000\000\000\001\246\002\146\000\000\000\000\000\000\002\158\002>\002\178\004\030\004*\012y\012y\000\000\000\000\0046\012y\0129\0129\012y\000\000\000\000\0129\0129\0129\000\000\000\000\004\138\000\000\012y\012y\012y\004:\012y\012y\012y\000\000\001\021\000\000\000\000\000\000\000\000\001\021\000\000\000\000\000\000\000\000\012y\000\000\000\000\000\000\000\000\000\000\012y\012y\000\000\000\000\012y\000\000\000\000\000\000\001\021\012y\000\000\000\000\012y\000\000\000\000\000\000\000\000\012y\012y\012y\000\000\000\000\000\000\000\000\000\000\000\000\012y\012y\000\000\000\000\001\021\000\000\018\182\012y\000\000\000\000\000\000\012y\001\021\000\000\012y\000\000\000\000\001\021\000\000\000\000\000\000\012y\012y\012y\000\000\012y\012y\001\021\000\000\000\000\000\000\000\000\000\000\000\000\007\253\012y\000\006\012y\012y\007\253\002\186\002\190\012y\002\234\002\130\000\000\000\000\012y\000\000\002\246\000\000\012y\001\021\012y\012y\000\000\003\254\000\000\007\253\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\007\253\003\222\0032\003\234\003\242\006\214\000\000\000\000\007\253\002\178\000\000\000\000\003:\007\253\007\253\000\238\b\026\b\030\b*\b>\000\000\005v\007\253\007\253\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\178\000\000\000\000\000\000\000\000\000\000\000\000\b\190\b\214\t*\005\130\005\134\000\000\000\000\007\253\000\000\000\000\007\253\000\000\000\000\000\000\000\000\000\000\000\006\000\000\000\000\007\253\002\186\002\190\000\000\002\234\002\130\000\000\000\000\005\138\b2\002\246\000\000\000\000\bJ\004r\t>\000\000\014n\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\006\214\000\000\000\000\000\000\002\178\000\000\000\000\003:\000\000\001\197\000\000\b\026\b\030\b*\b>\000\000\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005-\012\245\b\178\000\000\000\000\0051\012\245\001\197\000\000\b\190\b\214\t*\005\130\005\134\000\000\001\197\000\000\000\000\000\000\005-\001\197\001\197\000\238\005-\0051\000\000\003\029\003\029\0051\001\197\001\197\003\029\000\000\000\000\003\029\000\000\005\138\b2\000\000\000\000\000\000\bJ\004r\t>\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\012\245\012\245\003\029\000\000\000\000\012\245\012\245\003\029\003\029\003\029\000\000\000\000\000\000\005-\000\000\000\000\003\029\003\029\0051\012\245\000\000\012\245\000\000\003\029\012\245\000\000\012\245\003\029\005-\000\000\003\029\005-\000\000\0051\000\000\000\000\0051\003\029\003\029\003\029\004}\003\029\003\029\000\000\000\000\018\198\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\217\000\000\003\029\n\217\003\029\003\029\003V\002\190\000\000\000\000\002\130\000\000\006\166\000\000\000\000\002\246\000\000\000\000\000\000\n\217\n\217\018\242\n\217\n\217\000\000\001\210\000\000\006\198\000\000\017\018\000\000\000\000\003Z\000\000\017*\b\226\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\217\019.\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\217\003\250\000\000\004\002\005j\n\190\005v\000\000\004}\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\146\005z\001\202\001\206\000\000\000\000\000\000\000\000\000\000\005\130\005\134\000\000\005\202\n\217\000\000\n\217\000\000\000\000\000\000\000\000\000\000\001\210\001\214\000\000\000\000\000\000\000\000\n\217\000\000\000\000\n\217\n\217\000\000\005\138\000\000\n\217\000\000\n\217\000\000\004r\n\213\n\217\000\000\n\213\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\213\n\213\000\000\n\213\n\213\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\026\022\000\000\000\000\000\000\000\000\n\213\000\000\003f\000\000\000\000\003r\001\190\000\000\000\000\000\000\000\000\026\002\002\178\000\000\000\000\003\246\000\000\000\000\n\213\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\012Y\000\000\000\000\012Y\000\000\000\000\005\130\005\134\000\000\005\202\n\213\000\000\n\213\012Y\000\000\000\000\000\000\000\000\000\000\012Y\000\000\001\221\001\221\000\000\n\213\000\000\001\221\n\213\n\213\001\221\005\138\012Y\n\213\000\000\n\213\000\000\004r\012Y\n\213\001\221\001\221\001\221\000\000\001\221\001\221\001\221\012Y\000\000\000\000\012Y\000\000\000\000\000\000\000\000\012Y\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\012Y\000\000\001\221\000\000\012Y\001\221\000\000\000\000\000\000\000\000\001\221\001\221\001\221\000\000\012Y\012Y\000\000\000\000\012Y\001\221\001\221\000\000\000\000\000\000\027\242\000\000\001\221\001\r\000\000\000\000\001\221\000\000\001\r\001\221\000\000\012Y\000\000\000\000\000\000\000\000\001\221\001\221\001\221\0256\001\221\001\221\000\000\000\000\000\000\000\000\002\006\001\r\000\000\000\000\001\221\000\000\001\221\001\221\003V\002\190\002\n\001\221\002\130\000\000\006\166\000\000\001\221\002\246\001\210\000\000\004\254\000\000\001\221\001\r\000\000\003R\000\000\001\210\000\000\006\198\000\000\001\r\000\000\000\000\003Z\003\154\001\r\b\226\000\000\000\000\000\000\007\002\001\222\000\000\000\000\001\r\001\r\003f\002\178\000\000\n\174\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\177\003\250\000\000\004\002\000\000\n\190\005v\000\000\001\r\000\000\003V\002\190\000\000\007\006\002\130\000\000\006\166\001\r\005z\002\246\000\000\000\000\000\000\000\000\000\000\000\000\005\130\005\134\000\000\001\210\n\198\006\198\000\000\000\000\000\000\000\000\003Z\000\000\000\000\b\226\000\000\000\000\000\000\000\000\n\177\n\206\000\000\n\177\011:\003f\005\138\000\000\n\174\001\190\n\177\000\000\004r\000\000\n\177\002\178\000\000\000\000\003\246\000\000\000\000\n\177\003\250\000\000\004\002\000\000\n\190\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\000\000\000\000\000\000\000\000\000\000\000\000\005\130\005\134\000\000\000\000\n\198\005}\005}\000\000\000\000\000\000\005}\000\000\000\000\005}\000\000\000\000\000\000\000\000\n\177\000\000\000\000\n\177\n\177\005}\005\138\005}\000\000\005}\n\177\005}\004r\000\000\n\177\000\000\000\000\000\000\000\000\000\000\000\000\000\246\000\000\005}\002\194\000\000\000\000\000\000\000\000\005}\005}\000\000\000\000\000\000\028J\005}\000\000\000\000\005}\000\000\003\182\005}\000\000\000\000\000\000\000\000\005}\005}\005}\000\000\000\000\000\000\003\186\000\000\000\000\000\000\000\000\000\000\016\174\000\000\000\000\000\000\005}\005}\000\000\000\000\005}\024Z\000\000\001\006\017\018\000\000\000\000\000\000\000\000\017*\005}\005}\005}\000\000\005}\005}\000\000\000\000\000\000\001\n\007n\000\000\000\000\002\142\000\000\0172\000\000\005}\000\000\027\250\005}\005}\001\014\001\018\001\022\001\026\001\030\001\"\000\000\017F\017r\000\000\005}\004\149\000\000\001&\000\000\001.\0012\000\000\000\000\000\000\000\000\0016\004a\000\000\001:\000\000\000\000\000\246\021\154\000\000\002\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\178\001>\001B\001F\001J\001N\003\182\005q\005q\001R\000\000\000\000\005q\001V\000\000\005q\000\000\000\000\017\182\000\000\000\000\000\000\001Z\000\000\017\222\005q\000\000\005q\001^\005q\000\000\005q\000\000\000\000\000\000\000\000\017\018\000\000\001\154\027.\000\000\017*\000\000\005q\000\000\001\158\000\000\001\162\000\000\005q\005q\001\166\000\000\001\170\001\174\007\222\000\000\018Z\005q\000\000\000\000\005q\000\000\000\000\000\000\000\000\005q\005q\000\238\000\000\000\000\017F\018n\000\000\000\000\004a\004a\000\000\000\000\000\000\000\000\000\000\005q\005q\000\000\000\000\005q\000\000\b\245\000\000\000\000\000\000\018~\000\000\000\000\000\000\005q\005q\005q\000\000\005q\005q\000\000\000\000\t\202\000\000\000\000\012:\b\245\000\000\b\245\b\245\000\000\005q\000\000\000\000\005q\005q\n\002\n\026\n\"\n\n\n*\000\000\000\000\001\202\002~\000\000\005q\002\130\000\000\000\000\n2\n:\000\000\000\000\000\000\000\000\000\000\000\000\000\000\nB\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\t\210\n\018\nJ\nR\nb\000\000\000\000\000\000\000\000\002\138\002\146\000\000\nj\001\n\002\158\000\000\002\178\004\030\004*\000\000\000\000\nr\000\000\020\242\000\000\020\246\001\014\001\018\001\022\001\026\001\030\001\"\000\000\000\000\000\000\n\146\000\000\n\154\nZ\001&\004:\001.\0012\b\245\nz\000\000\000\000\0016\000\000\005\134\001:\000\000\n\130\n\138\000\000\000\000\000\000\000\000\000\000\021\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001>\001B\001F\001J\001N\000\000\003]\003]\001R\021\006\000\000\003]\001V\000\000\003]\000\000\000\000\000\000\000\000\000\000\000\000\001Z\000\000\000\000\003]\000\000\003]\001^\003]\000\000\003]\000\000\000\000\000\000\000\000\000\000\000\000\001\154\027J\000\000\000\000\000\000\003]\000\000\001\158\000\000\001\162\000\000\003]\003]\001\166\000\000\001\170\001\174\005\005\000\000\000\000\003]\000\000\000\000\003]\000\000\000\000\000\000\000\000\003]\003]\003]\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003]\000\000\001\202\001\206\003]\bq\bq\000\000\000\000\000\000\bq\000\000\000\000\bq\003]\003]\003]\000\000\003]\003]\000\000\001\210\001\214\bq\005\005\bq\000\000\bq\000\000\bq\000\000\003]\000\000\000\000\000\000\003]\000\000\000\000\000\000\000\000\000\000\bq\000\000\000\000\001\246\002\154\003]\bq\bq\002\158\000\000\002\178\004\030\004*\000\000\000\000\bq\000\000\0046\bq\015\158\000\000\000\000\000\000\bq\bq\bq\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\bq\000\000\000\000\000\000\bq\rA\rA\000\000\000\000\000\000\rA\000\000\000\000\rA\bq\bq\bq\000\000\bq\bq\000\000\000\000\000\000\rA\000\000\rA\000\000\rA\bq\rA\000\000\bq\000\000\000\000\000\000\bq\000\000\000\000\000\000\000\000\000\000\rA\000\000\000\000\004\254\000\000\bq\rA\rA\rE\rE\000\000\000\000\004B\rE\000\000\rA\rE\000\000\rA\000\000\000\000\000\000\000\000\rA\rA\rA\rE\000\000\rE\000\000\rE\000\000\rE\000\000\000\000\000\000\000\000\000\000\000\000\rA\000\000\000\000\000\000\rA\rE\000\000\000\000\000\000\000\000\000\000\rE\rE\000\000\rA\rA\rA\004B\rA\rA\rE\000\000\000\000\rE\004R\000\000\000\000\000\000\rE\rE\rE\rA\000\000\000\000\000\000\rA\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\rE\000\000\rA\000\000\rE\003]\003]\000\000\000\000\000\000\003]\000\000\000\000\003]\rE\rE\rE\000\000\rE\rE\000\000\000\000\000\000\003]\004R\003]\000\000\003]\000\000\003]\000\000\rE\001\202\001\206\000\000\rE\000\000\000\000\000\000\000\000\000\000\003]\000\000\000\000\000\000\000\000\rE\003]\003]\000\000\000\000\001\210\001\214\005\t\000\000\000\000\003]\000\000\000\000\003]\000\000\000\000\000\000\000\000\003]\003]\003]\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\246\002\162\000\000\000\000\000\000\002\158\003]\002\178\004\030\004*\003]\001\205\000\000\000\000\0046\000\000\001\205\000\000\001\206\001\205\003]\003]\003]\000\000\003]\003]\000\000\b\209\000\000\001\205\005\t\004:\000\000\001\205\004\205\001\205\000\000\003]\000\000\000\000\000\000\003]\000\000\004Y\000\000\000\000\000\000\001\205\004Y\000\000\026\002\000\000\003]\001\205\001\205\000\000\000\000\000\000\000\000\000\000\002\154\000\000\001\205\000\000\000\000\001\205\000\000\004Y\000\000\000\000\001\205\001\205\001\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\001\205\001\205\000\000\004Y\004\154\003A\000\000\000\000\000\000\000\000\003A\004Y\001\206\003A\001\205\001\205\004Y\002\226\001\205\001\205\000\000\b\205\000\000\003A\000\000\004Y\004Y\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\000\000\000\000\000\000\000\000\001\205\003A\001\201\000\000\000\181\004Y\000\000\000\000\002\154\000\181\003A\000\000\000\181\003A\004Y\000\000\000\000\000\000\003A\003A\003A\000\000\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\006\221\000\185\000\000\000\000\000\185\006\221\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\006\221\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\006\221\000\185\000\000\000\000\000\185\000\000\000\000\000\000\006\221\000\185\000\185\000\238\000\000\006\221\006\221\000\238\000\000\000\000\000\185\000\185\000\000\000\000\006\221\006\221\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\006\221\000\000\001\169\r\001\001\169\000\185\000\000\000\000\r\001\006\221\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\023\186\000\000\r\001\005\005\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\r\001\000\000\000\000\000\000\000\000\000\000\001\169\000\000\r\001\000\000\001\169\r=\r=\r\001\r\001\000\238\r=\000\000\000\000\r=\001\169\001\169\r\001\r\001\001\169\001\169\000\000\000\000\000\000\r=\005\005\r=\000\000\r=\001\169\r=\000\000\000\000\000\000\000\000\001\169\001\169\000\000\000\000\000\000\000\000\001\169\r=\r\001\000\000\000\000\000\000\001\169\r=\r=\000\000\000\000\r\001\000\000\000\000\000\000\000\000\r=\000\000\000\000\r=\000\000\000\000\000\000\000\000\r=\r=\r=\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r=\000\000\000\000\000\000\r=\r9\r9\000\000\000\000\000\000\r9\000\000\000\000\r9\r=\r=\r=\000\000\r=\r=\000\000\000\000\000\000\r9\000\000\r9\000\000\r9\000\000\r9\000\000\r=\000\000\000\000\000\000\r=\000\000\000\000\000\000\000\000\000\000\r9\000\000\000\000\004\254\000\000\r=\r9\r9\000\000\000\000\000\000\000\000\000\000\000\000\004a\r9\000\000\000\000\r9\000\246\000\000\000\000\002\018\r9\r9\r9\000\000\000\000\000\000\000\000\000\000\000\000\017\178\000\000\000\000\000\000\004a\000\000\003\182\r9\000\000\bu\bu\r9\000\000\000\000\bu\000\000\000\000\bu\017\182\000\000\000\000\r9\r9\r9\017\222\r9\r9\bu\000\000\bu\000\000\bu\000\000\bu\000\000\007J\017\018\000\000\r9\000\000\000\000\017*\r9\000\000\000\000\bu\000\000\000\000\000\000\000\000\000\000\bu\bu\r9\000\000\000\000\000\000\018Z\000\000\000\000\bu\000\000\000\000\bu\000\000\000\000\000\000\000\000\bu\bu\000\238\017F\018n\000\000\000\000\004a\004a\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bu\000\000\000\000\000\000\bu\000\000\006\241\000\000\018~\000\000\000\000\000\000\000\000\000\000\bu\bu\bu\000\000\bu\bu\000\000\000\000\t\202\000\000\000\000\006\241\000\000\000\000\bu\006\241\000\000\bu\000\000\000\000\000\000\bu\n\002\n\026\n\"\n\n\n*\000\000\000\000\000\000\000\000\000\000\bu\001\201\000\000\000\000\n2\n:\001\201\000\000\001\206\001\201\000\000\000\000\000\000\nB\000\000\000\000\000\000\b\205\000\000\001\201\000\000\000\238\000\000\001\201\000\000\001\201\000\000\000\000\000\000\000\000\t\210\n\018\nJ\nR\nb\000\000\000\000\001\201\000\000\000\000\000\000\006\241\nj\001\201\000\000\000\000\000\000\000\000\000\000\000\000\002\154\nr\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\146\000\000\n\154\nZ\000\000\000\000\000\000\000\000\000\000\nz\000\000\001\201\001\201\000\000\000\000\004\154\000\000\n\130\n\138\000\000\000\000\000\000\016b\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\t\202\001\201\000\000\000\000\016f\000\000\000\000\000\000\001\201\000\000\000\000\000\000\000\000\001\201\n\002\n\026\n\"\n\n\n*\001\201\000\000\000\000\000\000\000\000\000\000\n\210\000\000\000\000\n2\n:\000\246\001\202\001\206\002\018\000\000\000\000\000\000\nB\000\000\000\000\000\000\000\000\000\000\017\178\000\000\000\238\000\000\004a\000\000\003\182\001\210\001\214\001\230\000\000\t\210\n\018\nJ\nR\nb\000\000\001\242\017\182\000\000\000\000\000\000\000\000\nj\017\222\000\000\000\000\000\000\000\000\000\000\001\246\002\146\nr\000\000\000\000\002\158\017\018\002\178\004\030\004*\000\000\017*\000\000\000\000\0046\000\000\n\146\016j\n\154\nZ\016z\000\000\000\000\000\000\000\000\nz\000\000\018Z\000\000\000\000\000\000\004:\000\000\n\130\n\138\005\169\005\169\000\000\000\000\000\000\005\169\017F\018n\005\169\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\169\000\000\005\169\000\000\005\169\000\000\005\169\000\000\000\000\018~\000\000\000\000\000\000\000\000\004n\000\000\004r\000\000\005\169\000\000\000\000\000\000\000\000\000\000\005\169\005\169\000\000\000\000\000\000\000\000\007\222\000\000\000\000\005\169\000\000\000\000\005\169\000\000\006I\000\000\000\000\005\169\005\169\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\169\006I\002\225\000\000\005\169\000\000\001\210\002\225\000\000\000\000\002\250\000\000\000\000\002\225\005\169\005\169\005\169\002\225\005\169\005\169\000\000\002\254\000\000\000\000\002\225\000\n\000\000\000\000\006\218\0032\001\190\005\169\000\000\000\000\015:\005\169\002\178\002\225\000\000\003:\002\225\002\225\000\000\b\026\b\030\b*\005\169\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\165\007\030\000\000\005\130\005\134\005\165\002\225\000\000\005\165\000\000\000\000\000\000\000\000\000\000\002\225\002\225\000\000\015v\005\165\000\000\005\165\000\000\005\165\000\000\005\165\000\000\000\000\005\138\b2\000\000\000\000\000\000\bJ\004r\000\000\000\000\005\165\000\000\002\225\000\000\000\000\000\000\005\165\007\138\002\225\000\000\000\000\000\000\000\000\000\000\000\000\005\165\000\000\000\000\005\165\000\000\000\000\004\133\000\000\005\165\005\165\000\238\021\194\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\165\000\000\005\193\005\193\005\165\000\000\003\182\005\193\000\000\000\000\005\193\000\000\000\000\000\000\005\165\005\165\005\165\000\000\005\165\005\165\005\193\000\000\005\193\000\000\005\193\000\000\005\193\000\000\0222\000\000\000\000\005\165\000\000\000\000\000\000\005\165\017\018\000\000\005\193\000\000\000\000\017*\000\000\000\000\005\193\005\193\005\165\000\000\000\000\000\000\022\214\022\230\000\000\005\193\000\000\000\000\005\193\000\000\000\000\000\000\000\000\005\193\005\193\005\193\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\133\005\193\000\000\005\189\007\030\005\193\000\000\000\000\005\189\023\218\000\000\005\189\000\000\000\000\000\000\005\193\005\193\005\193\000\000\005\193\005\193\005\189\000\000\005\189\000\000\005\189\000\000\005\189\000\000\000\000\000\000\000\000\005\193\000\000\000\000\000\000\005\193\000\000\000\000\005\189\000\000\000\000\000\000\000\000\000\000\005\189\007\138\007\130\000\000\000\000\000\000\000\000\000\000\000\000\005\189\000\000\000\000\005\189\000\000\000\000\000\000\000\000\005\189\005\189\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\189\003V\002\190\000\000\005\189\002\130\000\000\006\166\000\000\000\000\002\246\000\000\000\000\000\000\005\189\005\189\005\189\000\000\005\189\005\189\001\210\000\000\006\198\000\000\000\000\000\000\000\000\003Z\000\000\000\000\b\226\005\189\000\000\000\000\000\000\005\189\000\000\000\000\000\000\000\000\003f\000\000\000\000\n\174\001\190\000\000\005\189\012\186\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\n\190\005v\t\202\000\000\000\000\012:\000\000\000\000\000\000\b\245\000\000\000\000\000\000\005z\000\000\000\000\n\002\n\026\n\"\n\n\n*\005\130\005\134\000\000\000\000\n\198\000\000\000\000\000\000\000\000\n2\n:\000\000\000\000\000\000\000\000\000\000\000\000\000\000\nB\n\206\000\000\000\000\n\218\000\000\005\138\000\000\000\238\000\000\000\000\000\000\004r\000\000\000\000\000\000\000\000\t\210\n\018\nJ\nR\nb\000\000\003=\000\000\000\000\000\000\000\000\003=\nj\001\206\003=\000\000\000\000\000\000\000\000\000\000\000\000\nr\000\000\000\000\003=\000\000\000\000\000\000\003=\000\000\003=\000\000\000\000\000\000\000\000\n\146\000\000\n\154\nZ\000\000\000\000\000\000\003=\000\000\nz\000\000\000\000\000\000\003=\000\000\000\000\001M\n\130\n\138\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\153\001\133\001I\001I\001I\000\000\001I\001I\000\000\012\153\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\153\000\000\000\000\000\000\000\000\000\000\012\153\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\153\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\130\001\213\000\000\002\130\000\000\0019\000\000\000\000\000\000\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\000\000\000\000\000\000\001\213\000\000\000\000\000\000\000\000\000\000\001\213\000\000\000\000\000\000\000\000\0019\015\134\000\000\000\000\001\213\000\000\000\000\001\213\000\000\000\000\000\000\0019\001\213\001\213\000\000\015\146\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\213\000Y\000\000\000\000\001\213\000\000\000Y\000\000\000Y\000\000\000\000\000\000\000\000\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\145\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\166\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\006\198\000\000\000Y\000\000\000\000\003Z\000\000\b\145\b\226\000\000\000\000\000Y\004Y\007\030\000Y\000\000\t&\004Y\003f\000\000\004Y\r\166\001\190\000\000\000\000\000\000\000\000\000Y\002\178\000\000\004Y\003\246\000\000\000\000\004Y\003\250\004Y\004\002\000\000\n\190\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004Y\000\000\000\000\000\000\005z\000\000\004Y\007\138\000\000\000\000\004Y\000\000\005\130\005\134\000\000\004Y\000\000\000\000\004Y\000\000\000\000\000\000\000\000\004Y\002\226\000\238\000\000\000\000\000\000\000\000\000\000\000\000\004Y\004Y\r\182\000\000\005\138\000\000\000\000\004Y\004Y\000\000\004r\004Y\000\000\012\022\000\000\000\000\000\000\000\000\012\022\000\000\000\000\004Y\004Y\000\000\000\000\004Y\004Y\000\000\000\000\t\202\000\000\000\000\000\000\000\000\t\202\004Y\012\026\000\000\000\000\000\000\000\000\012\242\004Y\n\002\n\026\n\"\n\n\n*\n\002\n\026\n\"\n\n\n*\004Y\000\000\000\000\000\000\n2\n:\000\000\000\000\000\000\n2\n:\000\000\000\000\nB\000\000\000\000\000\000\000\000\nB\000\000\000\000\000\238\000\000\000\000\000\000\000\000\000\238\000\000\000\000\000\000\t\210\n\018\nJ\nR\nb\t\210\n\018\nJ\nR\nb\000\000\000\000\nj\000\000\000\000\000\000\000\000\nj\000\000\000\000\000\000\nr\000\000\0035\000\000\000\000\nr\000\000\0035\000\000\000\000\0035\000\000\000\000\000\000\n\146\000\000\n\154\nZ\000\000\n\146\0035\n\154\nZ\nz\0035\000\000\0035\000\000\nz\000\000\000\000\n\130\n\138\000\000\000\000\000\000\n\130\n\138\0035\015\154\000\000\000\000\000\000\000\000\0035\000\000\000\000\000\000\000\000\000\000\000\000\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\166\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\006\198\000\000\000\000\000\000\000\000\003Z\0035\0035\b\226\000\000\0035\0035\000\000\000\000\000\000\000\000\023B\000\000\003f\000\000\0035\003r\001\190\000\000\000\000\000\000\015\250\0035\002\178\000\000\000\000\003\246\0035\000\000\000\000\003\250\000\000\004\002\0035\n\190\005v\000\000\000\000\000\000\003V\002\190\000\000\000\000\002\130\000\000\006\166\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\178\006\198\000\000\000\000\000\000\000\000\003Z\000\000\000\000\b\226\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\024\014\003f\005\138\000\000\n\174\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\n\190\005v\000\000\000\000\000\000\003V\002\190\000\000\000\000\002\130\000\000\006\166\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\n\198\006\198\000\000\000\000\000\000\000\000\003Z\000\000\000\000\b\226\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\022J\003f\005\138\000\000\n\174\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\n\190\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\n\198\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\170\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\017\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\017\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\022\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\017\000\000\002\225\000\000\004r\004A\004A\000\000\000\000\004A\002\225\002\225\000\000\002\225\004A\000\000\000\000\000\000\000\000\000\000\004A\000\000\000\000\000\000\004A\000\000\000\000\000\000\000\000\000\000\000\000\004A\022\250\000\000\002\225\023\018\000\000\000\000\002\225\000\000\002\225\000\000\000\000\000\000\004A\000\000\000\000\004A\004A\000\000\000\000\000\000\000\000\000\000\004A\000\000\000\000\004A\000\000\000\000\000\238\004A\000\000\004A\004A\000\000\004A\0035\000\000\000\000\000\000\0035\0035\000\000\000\000\0035\0035\000\000\004A\0035\000\000\000\000\000\000\000\000\000\000\0035\004A\004A\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\154\000\000\000\000\0035\015\154\0035\004A\000\000\000\000\0035\000\000\000\000\004A\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\134\000\000\0035\0035\025\182\000\000\0035\0035\012\145\000\000\000\000\000\000\000\000\012\145\000\000\000\000\012\145\000\000\015\250\0035\000\000\000\000\015\250\0035\0035\000\000\012\145\000\000\0035\000\000\012\145\000\000\012\145\000\000\000\000\000\000\000\000\000\000\004\253\000\000\000\000\000\000\000\000\000\000\012\145\000\000\000\000\000\000\000\000\000\000\012\145\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\145\000\000\000\000\012\145\000\000\000\000\003V\002\190\012\145\012\145\002\130\000\000\006\166\000\000\000\000\002\246\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\145\001\210\000\000\006\198\012\145\000\000\000\000\000\000\003Z\000\000\000\000\b\226\000\000\000\000\012\145\012\145\002z\000\000\012\145\012\145\000\000\003f\000\000\000\000\t\014\001\190\000\000\000\000\012\145\000\000\000\000\002\178\026v\000\000\003\246\012\145\000\000\000\000\003\250\000\000\004\002\000\000\n\190\005v\005U\000\000\012\145\000\000\000\000\005U\000\000\000\000\005U\000\000\000\000\005z\000\000\000\000\000\000\000\000\000\000\000\000\005U\005\130\005\134\000\000\005U\000\000\005U\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005U\000\000\000\000\000\000\000\000\000\000\005U\005\138\000\000\000\000\000\000\000\000\007\222\004r\000\000\005U\000\000\000\000\005U\000\000\000\000\000\000\000\000\005U\005U\000\238\000\000\005Y\000\000\000\000\000\000\000\000\005Y\000\000\000\000\005Y\000\000\000\000\000\000\005U\005U\000\000\000\000\005U\000\000\005Y\000\000\000\000\000\000\005Y\000\000\005Y\000\000\005U\005U\000\000\000\000\005U\005U\000\000\000\000\000\000\000\000\005Y\000\000\000\000\000\000\000\000\000\000\005Y\000\000\0035\000\000\000\000\005U\007\222\0035\000\000\005Y\0035\000\000\005Y\000\000\000\000\000\000\005U\005Y\005Y\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\005Y\005Y\000\000\000\000\005Y\0035\015\154\000\000\000\000\000\000\000\000\0035\000\000\000\000\005Y\005Y\000\000\000\000\005Y\005Y\0035\000\000\000\000\0035\000\000\000\000\000\000\000\000\0035\0035\0035\006\001\000\000\000\000\000\000\005Y\006\001\000\000\000\000\006\001\000\000\000\000\000\000\000\000\0035\000\000\005Y\000\000\0035\006\001\000\000\000\000\000\000\006\001\000\000\006\001\000\000\000\000\0035\0035\017\130\000\000\0035\0035\000\000\000\000\000\000\006\001\000\000\000\000\000\000\000\000\000\000\006\001\000\000\000\000\000\000\000\000\015\250\0035\000\000\000\000\006\001\000\000\000\000\006\001\000\000\000\000\000\000\000\000\006\001\006\001\000\238\000\000\000\000\000\000\000\000\000\000\025^\000\000\000\000\000\000\000\000\000\000\003V\002\190\006\001\000\000\002\130\000\000\006\001\000\000\000\000\002\246\000\000\000\000\000\000\000\000\000\000\000\000\006\001\006\001\021>\001\210\006\001\006\001\000\000\000\000\000\000\000\000\003Z\001\202\001\206\000\000\006\001\000\000\000\000\000\000\000\000\000\000\000\000\006\001\000\000\003f\000\000\000\000\003r\001\190\000\000\000\000\001\210\001\214\006\001\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\209\000\000\005\138\000\000\006\146\000\000\b\202\003f\004r\000\000\003r\001\190\000\000\000\000\000\000\000\000\026\002\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\006.\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\006R\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\006:\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\129\000\000\000\000\007\129\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\129\007\129\003\246\007\129\007\129\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\006M\000\000\000\000\005z\007\129\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\006M\000\000\007\129\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\166\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\129\000\000\007\129\002\178\000\000\000\000\003\246\000\000\000\000\001\210\003\250\000\000\004\002\005j\005\226\005v\003Z\007\129\007\129\000\000\000\000\000\000\007\129\000\000\007\129\000\000\000\000\005z\007\129\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\178\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\190\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\006q\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\006q\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\b\026\b\030\b*\000\000\000\000\005v\000\000\000\000\000\000\006\249\007\030\000\000\000\000\000\000\006\249\000\000\000\000\006\249\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\130\005\134\006\249\000\000\000\000\000\000\006\249\000\000\006\249\000\000\001\181\000\000\000\000\000\000\000\000\001\181\000\000\000\000\001\181\000\000\006\249\000\000\000\000\000\000\005\138\b2\006\249\007\138\001\181\bJ\004r\000\000\001\181\000\000\001\181\006\249\000\000\000\000\006\249\000\000\000\000\000\000\000\000\006\249\006\249\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\006\249\000\000\001\181\000\000\006\249\001\181\000\000\000\000\000\000\000\000\001\181\001\181\001\181\000\000\006\249\006\249\000\000\000\000\006\249\006\249\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\006\249\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\142\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\005\000\000\000\000\000\000\000\000\006\005\001\217\000\000\006\005\001\217\000\000\000\000\000\000\000\000\001\217\001\217\000\000\000\000\006\005\000\000\000\000\000\000\006\005\000\000\006\005\000\000\000\000\000\000\000\000\000\000\001\217\000\000\000\000\000\000\001\217\000\000\006\005\000\000\000\000\000\000\000\000\000\000\006\005\000\000\001\217\001\217\000\000\000\000\001\217\001\217\000\000\006\005\000\000\000\000\006\005\000\000\000\000\000\000\001\217\006\005\006\005\000\238\000\000\000\000\000\000\001\217\000\000\000\000\000\000\000\000\021\026\000\000\000\000\000\000\000\000\006\005\001\217\012\145\000\000\006\005\000\000\000\000\012\145\000\000\000\000\012\145\000\000\000\000\000\000\006\005\006\005\000\000\000\000\006\005\006\005\012\145\000\000\000\000\000\000\012\145\000\000\012\145\000\000\006\005\000\000\000\000\000\000\004\253\000\000\000\000\006\005\000\000\000\000\012\145\000\000\000\000\000\000\000\000\000\000\012\145\000\000\006\005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\145\000\000\000\000\000\000\000\000\012\145\012\145\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012I\000\000\002\190\012I\000\000\028\002\000\000\012\145\000\000\000\000\028\006\000\000\000\000\012I\000\000\000\000\000\000\000\000\000\000\012I\000\000\012\145\012\145\002z\000\000\012\145\012\145\000\000\000\000\000\000\000\000\012I\000\000\000\000\000\000\012\145\000\000\012I\000\000\026\174\000\000\000\000\012\145\001\002\001\190\000\000\012I\000\000\000\000\012I\000\000\000\000\000\000\012\145\012I\004Y\000\000\000\000\000\000\000\000\004Y\000\000\028\n\004Y\000\000\000\000\000\000\000\000\000\000\000\000\012I\000\000\000\000\004Y\012I\000\000\000\000\004Y\000\000\004Y\000\000\000\000\000\000\028\014\012I\012I\000\000\000\000\012I\000\000\000\000\004Y\000\000\000\000\000\000\000\000\000\000\004Y\b1\b1\000\000\000\000\b1\007\222\000\000\012I\004Y\b1\000\000\004Y\000\000\000\000\000\000\016*\004Y\002\226\000\238\b1\000\000\000\000\000\000\000\000\000\000\000\000\b1\000\000\000\000\000\000\000\000\000\000\004Y\000\000\000\000\000\000\004Y\000\000\000\000\b1\000\000\000\000\b1\b1\000\000\000\000\004Y\004Y\000\000\b1\004Y\004Y\b1\000\000\000\000\000\000\b1\000\000\b1\b1\007J\b1\000\000\000\000\000\000\000\000\001q\004Y\000\000\000\000\000\000\001q\025~\b1\001q\000\000\000\000\000\000\004Y\000\000\000\000\b1\b1\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\b1\000\000\000\000\001q\000\000\000\237\b1\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\006\245\000\000\000\000\000\000\000\000\006\245\000\237\000\000\006\245\000\000\000\241\000\000\000\000\000\000\000\000\000\000\000\241\000\237\006\245\000\000\000\000\000\000\006\245\000\000\006\245\000\241\000\000\000\000\000\241\000\000\000\000\000\000\000\000\000\241\000\241\000\238\006\245\000\000\000\000\000\000\000\000\000\000\006\245\000\000\000\000\000\000\000\000\000\000\000\000\000\241\000\000\006\245\000\000\000\241\006\245\000\000\000\000\000\000\000\000\006\245\006\245\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\006\245\000\000\000\000\000\000\006\245\000\000\000\000\000\000\000\000\000\241\000\000\006\201\006\201\000\000\006\245\006\245\016\194\000\000\006\245\006\245\000\241\005\249\000\000\000\000\000\000\000\000\005\249\000\000\000\000\005\249\006\201\006\201\006\201\000\000\000\000\006\245\017b\000\000\000\000\005\249\006\201\000\000\000\000\005\249\000\000\005\249\000\000\005a\007\030\000\000\000\000\000\000\005a\006\201\006\201\005a\000\000\005\249\006\201\000\000\006\201\006\201\006\201\005\249\000\000\005a\000\000\006\201\000\000\005a\000\000\005a\005\249\000\000\000\000\005\249\000\000\000\000\000\000\000\000\005\249\005\249\000\000\005a\006\201\000\000\000\000\000\000\000\000\005a\007\138\000\000\000\000\000\000\000\000\000\000\005\249\000\000\000\000\000\000\005\249\005a\000\000\000\000\000\000\000\000\005a\005a\000\238\000\000\005\249\005\249\000\000\000\000\005\249\005\249\000\000\000\000\000\000\000\000\011\249\000\000\005a\000\000\000\000\011\249\000\000\004\230\011\249\000\000\000\000\005\249\000\000\000\000\000\000\000\000\005a\005a\011\249\000\000\005a\005a\011\249\000\000\011\249\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\249\005a\000\000\000\000\000\000\000\000\011\249\000\000\000\000\000\000\000\000\000\000\000\000\001\202\002~\011\249\000\000\002\130\011\249\000\000\000\000\000\000\000\000\011\249\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\011\249\t\190\000\000\001\242\011\249\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\249\011\249\002\138\002\146\011\249\011\249\000\000\002\158\000\000\002\178\004\030\004*\0041\000\000\000\000\000\000\020\242\0041\026Z\004)\0041\011\249\000\000\000\000\004)\000\000\000\000\004)\000\000\000\000\0041\000\000\n\162\004:\0041\000\000\0041\004)\000\000\000\000\000\000\004)\005\134\004)\000\000\000\000\000\000\000\000\0041\000\000\000\000\000\000\026f\000\000\0041\004)\000\000\000\000\000\000\000\000\000\000\004)\000\000\0041\000\000\000\000\0041\000\000\000\000\021\006\004)\0041\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\0041\000\000\000\000\000\000\0041\004I\000\000\004)\000\000\000\000\004I\004)\004\025\004I\0041\0041\000\000\004\025\0041\0041\004\025\004)\004)\004I\000\000\004)\004)\004I\000\000\004I\004\025\000\000\000\000\000\000\004\025\0041\004\025\000\000\000\000\000\000\000\000\004I\004)\000\000\000\000\000\000\016\234\004I\004\025\000\000\000\000\000\000\000\000\019\214\004\025\000\000\004I\000\000\000\000\004I\000\000\000\000\000\000\004\025\004I\000\000\004\025\000\000\000\000\000\000\000\000\004\025\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004I\000\000\000\000\n\222\004I\000\000\000\000\004\025\000\000\001\202\001\206\004\025\000\000\000\000\004I\004I\000\000\000\000\004I\004I\000\000\004\025\004\025\002\142\000\000\004\025\004\025\000\000\001\210\001\214\001\230\000\000\000\000\000\000\000\000\004I\000\000\000\000\001\242\000\000\000\000\000\000\004\025\000\000\000\000\001\250\020\182\006\205\006\205\000\000\000\000\001\246\002\146\024.\000\000\000\000\002\158\000\000\002\178\004\030\004*\000\000\000\000\004.\000\000\0046\006\205\006\205\006\205\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\205\000\000\000\000\000\000\000\000\000\000\004:\000\000\000\000\000\000\000\000\000\000\000\000\006\205\006\205\000\000\000\000\000\000\006\205\000\000\006\205\006\205\006\205\000\000\0049\000\000\000\000\006\205\000\000\0049\000\000\004!\0049\000\000\000\000\015\138\004!\000\000\000\000\004!\000\000\000\000\0049\000\000\006\205\000\000\0049\000\000\0049\004!\000\000\000\000\000\000\004!\000\000\004!\000\000\000\000\000\000\000\000\0049\000\000\000\000\000\000\000\000\000\000\0049\004!\000\000\004Q\000\000\000\000\000\000\004!\004Q\000\000\000\000\004Q\0049\000\000\004\"\000\000\006\205\0049\000\000\004!\000\000\004Q\000\000\000\000\004!\004Q\000\000\004Q\000\000\000\000\000\000\000\000\000\000\0049\000\000\000\000\000\000\000\000\000\000\004Q\004!\000\000\000\000\000\000\000\000\004Q\000\000\0049\0049\000\000\000\000\0049\0049\000\000\004!\004!\000\000\004Q\004!\004!\000\000\000\000\004Q\011*\000\000\000\000\000\000\000\000\0049\001\202\001\206\000\000\000\000\000\000\000\000\004!\000\000\000\000\004Q\018\018\000\000\000\000\000\000\000\000\000\000\003\254\020b\000\000\001\210\001\214\001\230\000\000\004Q\004Q\000\000\000\000\004Q\004Q\001\242\004m\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\004Q\000\000\000\000\002\158\003\178\002\178\004\030\004*\004m\000\000\003\182\020\222\0046\007\149\000\000\000\000\007\149\000\000\000\000\000\000\000\000\000\000\003\186\000\000\000\000\000\000\000\000\000\000\016\174\004:\000\000\000\000\007\149\007\149\000\000\007\149\007\149\024Z\000\000\000\000\017\018\000\000\000\000\000\000\000\000\017*\000\000\000\000\000\000\007m\000\000\000\000\007m\000\000\000\000\000\000\007\149\000\000\000\000\000\000\000\000\0172\000\000\000\000\000\000\004n\000\000\004r\007m\007m\000\000\007m\007m\000\000\000\238\017F\017r\000\000\000\000\004m\004m\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007m\000\000\007\153\000\000\021\154\007\153\000\000\000\000\000\000\000\000\000\000\000\000\007\149\000\000\007\149\000\000\000\000\000\000\007m\000\000\000\000\007\153\007\153\000\000\007\153\007\153\007\149\000\000\000\000\005\234\007\149\000\000\000\000\000\000\007\149\007\137\007\149\000\000\007\137\000\000\007\149\000\000\000\000\000\000\000\000\007\153\000\000\000\000\007m\000\000\007m\000\000\000\000\000\000\007\137\007\137\000\000\007\137\007\137\000\000\000\000\000\000\007m\000\238\000\000\005\234\007m\000\000\000\000\000\000\007m\000\000\007m\000\000\000\000\000\000\007m\000\000\007\137\000\000\rI\rI\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\153\000\000\007\153\000\238\000\000\000\000\rI\rI\rI\0072\000\000\000\000\000\000\000\000\007\153\000\000\rI\005\234\007\153\000\000\000\000\000\000\007\153\000\000\007\153\001\202\001\206\022N\007\153\rI\rI\000\000\000\000\007\137\rI\007\137\rI\rI\rI\000\000\000\000\000\000\000\000\rI\001\210\002\170\001\230\006*\000\000\000\000\005\234\007\137\000\000\000\000\001\242\007\137\000\000\007\137\000\000\000\000\rI\007\137\000\000\001\202\001\206\022\174\000\000\001\246\002\146\000\000\000\000\000\000\002\158\000\000\002\178\004\030\004*\000\000\000\000\000\000\000\000\0046\001\210\002\170\001\230\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\242\000\000\000\000\000\000\000\246\000\000\004:\002\194\000\000\000\000\000\000\000\000\000\000\001\246\002\146\000\000\000\000\004\141\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\174\000\000\000\000\004:\000\000\000\000\000\000\000\000\000\000\024Z\000\000\000\000\017\018\000\000\000\000\000\000\000\000\017*\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0172\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017F\017r\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\154"))
and lhs =
- (8, "\012\011\n\t\b\007\006\005\004\003\002\001\000\216\216\215\215\214\213\213\212\212\212\212\212\212\212\212\212\212\212\212\212\212\212\212\212\212\212\212\211\211\210\209\209\209\209\209\209\209\209\208\208\208\208\208\208\208\208\207\207\207\206\206\205\204\204\204\203\203\202\202\202\202\202\202\201\201\201\201\201\201\201\201\200\200\200\200\200\200\200\200\199\199\199\199\198\197\196\196\196\196\195\195\195\195\194\194\194\193\193\193\193\192\191\191\191\190\190\189\189\188\188\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\186\186\185\185\184\183\182\181\181\180\180\179\179\179\179\178\178\178\178\177\177\176\176\176\176\175\174\173\173\172\172\171\171\170\169\169\168\167\167\166\165\164\164\164\163\163\162\161\161\161\161\161\160\160\160\160\160\160\160\160\159\159\159\159\159\159\158\158\157\157\157\156\156\155\155\155\154\154\153\153\152\152\151\151\150\150\149\149\148\148\147\147\146\146\145\145\144\144\144\143\143\143\143\142\142\141\141\140\140\139\139\139\139\139\138\138\138\138\137\137\137\136\136\136\136\136\136\136\135\135\135\135\135\135\135\134\134\133\133\132\132\132\132\132\132\131\131\130\130\129\129\128\128\127\127\127~}}}||{{{{{{{{{zzyyxxxxxxxxxxxwvuutttttsrrqqppppppppppppppoonnmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmllkkjjiihhggffeeddccbbaaaaaaaaaaa`_^]\\[ZYXWWWWWWWWWWVVVUUUTTTTSSSSSSSSSRRQQQQQPPOONMLLKKKKKJJIIHHHGGGGGGFFFEEDDCCBBAA@@@??>>==<<;;::9988776655544433322211110/..................-----,,,,,,,+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++**))))))))))))))))))))))(((((((((((((((((((((((((((((((((((((((((((((((((((''&&&%%$$$$$$$$$$$$$$$$##\"\"!!!!!!! \031\031\030\030\030\030\030\029\029\028\027\026\026\026\025\025\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\r\r")
+ (8, "\012\011\n\t\b\007\006\005\004\003\002\001\000\216\216\215\215\214\213\213\212\212\212\212\212\212\212\212\212\212\212\212\212\212\212\212\212\212\212\212\211\211\210\209\209\209\209\209\209\209\209\208\208\208\208\208\208\208\208\207\207\207\206\206\205\204\204\204\203\203\202\202\202\202\202\202\201\201\201\201\201\201\201\201\200\200\200\200\200\200\200\200\199\199\199\199\198\197\196\196\196\196\195\195\195\195\194\194\194\193\193\193\193\192\191\191\191\190\190\189\189\188\188\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\186\186\185\185\184\183\182\181\181\180\180\179\179\179\179\178\178\178\178\177\177\176\176\176\176\175\174\173\173\172\172\171\171\170\169\169\168\167\167\166\165\164\164\164\163\163\162\161\161\161\161\161\160\160\160\160\160\160\160\160\159\159\159\159\159\159\158\158\157\157\157\156\156\155\155\155\154\154\153\153\152\152\151\151\150\150\149\149\148\148\147\147\146\146\145\145\144\144\144\143\143\143\143\142\142\141\141\140\140\139\139\139\139\139\138\138\138\138\137\137\137\136\136\136\136\136\136\136\135\135\135\135\135\135\135\134\134\133\133\132\132\132\132\132\132\131\131\130\130\129\129\128\128\127\127\127~}}}||{{{{{{{{{zzyyxxxxxxxxxxxwvuutttttsrrqqppppppppppppppoonnmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmllkkjjiihhggffeeddccbbaaaaaaaaaaa`_^]\\[ZYXWWWWWWWWWWVVVUUUTTTTSSSSSSSSSRRQQQQQPPOONMLLKKKKKJJIIHHHGGGGGGFFFEEDDCCBBAA@@@??>>==<<;;::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\r\r")
and goto =
- ((16, "\000%\000\193\000G\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\012\000\000\000\000\000\129\001\152\000\030\0003\000#\000\004\000\190\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\000\000\000\000\000\000\000\000\000\000\000t\000\000\000\000\000\000\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\000\000\000=2\000\000\000\000\000\000\000\254\000\000\000\000\000\000\000\000\000\000\000\000\000\000'\238\001T\001>\000\223\000\000\001B9\220\001\236\001\218\000:\000\000\001x\000\000\000\182\003\156\000\000\002\150\000\000\000\000\000\000\000\000\000\000\001\022\000\000\000\218\003\202\bf\000\000\000\000\011\018'\238\000\000\000\000\001\254\000\000\000\027\000\000:~\002\184\000\000\001\156\001r\000\000\000\000\002\172\002\142\002\208\003b\001\226\003\202\004\142\000f\001\194\0022\003\216\002\152\011b\000\000\005(\003\244\003\188\002h\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004r\000\000\t>\005(\011\194\000\000\000\000\004.\005d\004\0301\236\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\148\000\000\004\168\005l\005@\000\000\000\000\000\000\000\000\000\173\000\000\000\000\005\144\000\167\006\018\006(\007\214\000\000\0050\005H\006*\000Q\004\228\006L \232\000\000\000\000\005X\006\254\011\204\000\000!\b\001\244!\026\"V\000\000\003B\000\000\000\000\000\000\000\000\006\018=F\006\020\000\000\001\012\0064\000\000\004P6\150\000\131\000\000\001\172\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002:\005\190\000\000\000\000\000\000\000\192\000\000\tD\000\000\000\000\002\164\000o\000\000\000\000\003\248\000\000\006n\000\000\002\164\t\148\002\164\000\000\000\000\000\000\000\000\000\0007 \000\000\007\"\006@\000\000=\168\007N\030`\000\000\000\000\000\000\0062\000\000\000\000\000\000\000\000\006F\000\000\000\000\000\000\000\000\000\0002L\000\000\000\000\000\000\000\000\000\000\000\000\001\158\007N\000\000\000\000\000\000\006F\007\1342\146\006\224\007p\015\214\000\000\003\014\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000(\000\000\000\000\000\000\000\000\b\0122\160\000\000\000\000\007\030\b\0042\214\000\000\000\000\000\00038\007\0143\152\000\000\007\014\000\0003\164\007\014\000\0003\228\007\014\000\000\007\014\000\000\000\000\007\014\000\000\000\0004J\000\000\007\0144\138\000\000\007\014\002|\000\000\000\000\"V\000\000\000\000\000\000\000\000\007\014\"z\000\000\000\000\000\000\007\014\000\000\006F\007\246\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\016\000\000\007\136\000\000=\132\006F\000\000\000\000\000\000\000\000\b\b\b\184\012$\b\026\b\030\b@\b\028\005\014\b`\0001\t\006\000\000\000\000\000\029\005\136\b\160\001\172\b\200\bL\000\000\000\145\004\138\005\180\007\136\n\"\000\000\000\000C\158\000\000C\224\t\212\000\000=\198\006F>@\006F\000\000\003\"\000\000\003x\000\000\000\000\003\220\000\000\000\000\000\000\nt\000\000\n\030\000\145\000\000\000\000\t>\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\145\000\000\000\000\000\145\000\000\b\200\007\014\000\000\002\182\004\228\000\000\002\182\000\000\000\000\n\206\000\145\000\000\000\000\000\000\000\000\000\000\000\000\002\182\012\132\rL\n4\t\218\"\152\000n\000\000\t\130\b\182\r\158\t\234\b\228\025X1N\000\000\000\000\000\000\000\000\000\000\0032\t\188\000\000\000\000\000\000\t\250\b\244\007V\002\182\011\240\000\000\000\145\000\000\000\000\000\000\001\244\000\000>T\006F\r\166\n\018\t\030\r\254\n \t0\014\180\"\186\007\014\015\024\n\"\t89\190\n\244\000\000#\002\007\014>x\006F\n\238\000\000\000\000\000\000\000\000\007\148\011&\011L\000\000\000\000\b\176\015 \n\208\t>4\172\007\014\015t\n\222\tF6(\000\000>\172\000\000\000\000\015|\"\244\018\\\000\000\000\000\000\000\000\000>\208\000\000\000\000\000\000\007\172\016B\000\000\000\000\000\000\000\000#^>\222\000\000\000\000\000\000\000\000\000\000\n\170\016\150\000\000\n\180$\"\n\180$,\n\180\000\000?\026\000\000$\128\n\180\016\234\004\152\016\244\000\000\000\000$\136\n\180%\022\n\180%\030\n\180%\250\n\180&\002\n\180&\026\n\180&\152\n\180&\246\n\180&\254\n\180'\140\n\180'\148\n\180'\232\n\180(v\n\180(\128\n\180)\014\n\180)^\n\180)h\n\180)\246\n\180*F\n\180*\212\n\180\t\170*\2484\232\007\148\011x\000\000+8;l\000\000\017N\000\000?,\000\000\006F;\166\000\000\006F?P\006F\000\000\017\184\000\000\000\000\000\000+\\\000\000\000\000\000\000\000\000\000\000\007\014\000\000\000\000?\210\000\000\006F\000\000\000\000;\166\011\136\000\000@6\006F\018\018\000\000\000\000\011\"\000\000@H\006F\018\160\000\000\000\000\018\196\000\000\000\000\000\000@Z\006F\019\028\000\000\n\252\019\132\000\0005J\000\000\007\0145\142\000\000\007\0145\176\000\000\007\014\003d\000\000\000\000\000\000\000\000\000\0005\240\007\014\004\222\005\022\000\000\000\000\000\000\n\180\019\222\000\000\000\000\000\000+\150\n\180\000\000\000\000\000\000\000\000\0206\000\000\000\000\000\000\n\180\020D\000\000\020\158\000\000\000\000\000\000\021\004\000\000\000\000\000\000\000\000@\146\000\000\000\000\021^\000\000\000\000\000\000,H\n\180\021l\000\000\000\000\000\000,\138\n\180\021\196\000\000\000\000,\176\n\180\n\180\000\000\007\228\022\030\000\000\000\000-\b\n\180\022l\000\000\000\000-(\n\180-v\n\180\000\000.\004\n\180\000\000\000\000\022\250\000\000\000\000.\152\n\180\023,\000\000\000\000.\200\n\180\023\\\000\000\000\000.\232\n\180\000\000/\000\n\180\000\000;\138\000\000\000\000\n\180\000\000\000\000\023\142\000\000\000\000\023\192\000\000\000\000\011D\000\000\000\000\024\028\000\000\024$\000\000\000\000\000\000\007\148\011\226\000\0007\022\n<\002\164\025\004\000\0007r\000\000\000\000\000\0007\194\000\000\000\000\025$\000\000\025\146\000\000\000\000\000\000\000\000/\n\000\000\000\000\000\000/f\n\1800r\n\180\000\000\n\252\025\156\000\000\000\000\025\236\000\0000T\000\000\000\0001N\000\000\000\000\000\000\026\134\000\000\000\000\000\000\000\000\026\144\000\000\000\000\000\000\000\000\012\152\000\000\000\000\000\000\003\154\000\000\000<\000\000\000;\000\000\0128\000\000\004\144\000\000\000\000\000\000\000\000\000\000\000\000\0032\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\180\000\000\012\164\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\184\007\232\002\182\027T\000\000\011\166\t\224\012*\001\144\t\136\002\182\r@\000\145\t\176\002\182\000\000\027x\000\000\004\142\000\000\011\194\t\238\004X\000\000\000\000\000\000\000\000\000\000\011\218\001.\000\146\000\000\000\000\000\000;\222\000\000C\240\000\000\t\246\000\000\n\016\000\000\000\000\000\000\000\000\002\158\000\000\000\000\000\000\011*\002\164\000\000\002\164\001\178\000\000\rv\002\164\002\164\n\024\000\000\027\186\000\000\000\000\n8\012\172\000\0000\180\005$\000\000\000\000\000\000\000\000\000\000\000\000\n\180\000\000\028\180\000\000\n\180\000\000\000\000\014\242\000\000\000\145\000\000\016H\000\000\000\145\000\000\017\012\000\145\000\000\003Z\000\000\n<\n\022\005`\000\000\011\226\011\234\nV\012\024\012\164\017T\000\145\006\012\000\000\nZ\012\134\012\188\005\024\006\184\012\150\n\130\r\014\006\146\b\132\012\228\000\000\000\000\007\188\b\148\000\000\004\168\002\2426N\007\014\028\028\000\000\007X\003\178\012\158\n\154\011^\005\224\000\000\012\168\n\158\006\200\000\000@\172\006F\rZ\r\132\000\000\t:\000\000\012\244\n\166\006>\r2\003V\000\000\000\000\000\000\000\000\n\216\tZ\000\000\n\222\tl\000\000\bb\0164\rF\rP\n\228\006\216\t\172\000\000\n\230\007\138\n\018\000\000\rR\n\238\r\220\000\000\t\028\000\000\n\132\000\000\r\252\000\000\018\024\000\145\r\216\011\002\014\022\000\000\018\202\0056\r\236\000\000\000\000\003j\006\160\011$\000\000\019\228\000\145\011F\000\000\004\022\000\000\r\210\011\016\0212\006\154\000\000\r\222\011>\007\176\r2\r\230\r\240\011L\015F\000\000\014\000\001\200\000\000\000\000\000\000\000\000\000\171\011X\r\226@\190\006F\000\000\002\200\011\142\014\148\000\000\000\000\000\000\000\000\000\000\000\000A\000\006\164\000\000\011\182\014\246\000\000\000\000\000\000\000\000\000\000\000\000\006\174\000\000A\030\006F\011\226\000\000\006F\011\218\000\184\000\000\011\230\011\232\007\024\000\000\001\004\004L\000\000\002\190\000\000A\"\006F\006F\000\000\000\000\007\b\000\000\b\252\000\000\001\186\007\b\007\b\000\000\011\236;\204\006FA\152\006F\012\b\000\000\000\000\000\000\000\000\012\014\000\000\000\000\007N\000\000\007l\014`\011\240\015p\014*\000\000\000\000\001\196\b|\014h\000\000\000\000\011\250\015\128\014@\000\000\000\000\029\018\000\000\012\222\000\000!(6H\006F\000\000,N\018\132\000\000A\252\000\000\000\000\000\000\007\b\000\000\000\000\012:\014|\012\000\015\144\014J\000\000\000\000B\014\012\144\014\140\000\000\000\000\000\000<:\000\000\000\000\000\000\000\000\000\000\000\000\012\146\000\000\014\152\012\020\006\162\000\000\015\134\015>\012\180\014\166\000\000\000\000\014\170\012>\b*\000\000\000\000\tl6\150\005|\000\000\000\000\000\000\bL\014p\012p\000\000\014z\bL\000\000\015V\012\188\014\196\000\000\000\000\000\000\006F\003v\004(\005\180\000\000\000\000\000\000\000\000\014\138\012t\000\000\006\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006F\014z\012\128\015\208\014\138\000\0007\224\000\237\012\146\014^\003\156\000\019\012\150\015\016\000\000\015\200\028\130\000\000\000\000\029J\000\000\012\208\000\000\nL\000\000\000\000\000\000\000\000\000\000\000\000B\018\006F\000\000\015\204\029l\000\000\000\000\030\002\000\000\000\245\012\156\015r\000\000\000\0007\250:\020\015(\000\000B0\006F\0302\000\000\000\000\030T\000\000\000\000\r0\000\000\000\\\000\000\000\000\000\000\000\000\000\000\000\000:\204\000\000\000\0008\188:\208\015*\000\000BP\006F\030\234\000\000\000\000\031\028\000\000\000\000\012\184\031<\r<\000\000\012\190\012\198\002\016\002\208\012\200\t&\012\214\015|0\214\r\\\000\000\r\016\r2\tf\000\000\004*<Z\000\000\004.\000\000\rH9\0069Z\005\236\014j\006l\000\000\020\144;\138\000\000\0001\000\000\000\000\0001\000\000\000\000\0001\n\002\000\000\011\000\0001\015\1380\238\rh\000\000\0001\000\000\000\000Br\000\000\000\000\000\000\0001\000\000\000\000\r\166\000\000\r\030\005\190\r\200\000\000\rJ<\174\r\248\000\000\000\000\000\000\000\000\014\000\000\000\000\000\006\018\000\000\0001B\232\000\000\014\216\00019h\000\000\014\b\014\242\rN\016\n\014\200\000\0009r\014\014\015\002\000\000\000\000\000\000\019\012\b\026\000\000\000\000\000\000\000\000\000\000\000\000\n\170\014\020\000\000\015\018\000\000\000\000\000\000\000\000\014\026\027F\000\000\000\000\000\000\000\000\n\170\000\000\000\000\014.\031\170\000\000\000\000\000\000\000\000\000\000\002\182\000\145\000\000\000\000\007\014\000\000Bn\006F\000\000\007\212\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014\202\rP\011\246\002\182\000\000\022\n\000\000\000\145\000\000\016\004\000\000\000\000\000\000\000\000\000\000 (\000\000\000\000\000\000\000\000\000\000\000\000\015\170\002\022\t\210\014p\003\144\r\148\000\000\000\226\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014\138\005^\r\176\000\000\007$\016\n\015\188\014J\000\000\000\000\015\180\002\202\b\150\000\000\000\000\000\000\r\180\000\000\r\206\000\240\000\000\000\000\002\164\b\128\000\000\000\000\000\000\000\000\000\000.\226\000\000\000\000\007h\007\238\000\000\000\000C(\006F\006F\000\000CJ\006F\bP\000\000\000\000\000\000\006F\000\000\000\000\t\246\015\196\014\\\000\000\000\000\015\184\000\170\001\200\000\000\000\000\000\000\000\000\b\002\016\n\nl\015\200\014h\000\000\000\000\015\190\004\188\003\142\000\000\000\000\000\000\000\000\000\145\000\000\b\222\000\000\000\000\000\000 \004\000\000 \182\000\000\000\000\000\000\000\000\000\000-\226\000\000\000\000\000\000\005\022\000\190\000\000\000\000\000\000\000\000\000\000\002V\000\190\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0050\000\000\000\000\000\000<\198\000\000\006F\000\000\n*\000\000\000\000\000\000\001\030\000\000\000\000\000\000\001\214\000\000\000\000\000\000\0001\000\000\000\000\000\0000\250\007\014\000\000\000\000\000\014\000\000\000\000\000\000\000\000\0032\004\128\015\b\004D\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000=.\000\000\014v\000\000\000\000\000\000\000\000\005H\006\246\r@+\182\000\000\000\000\014\150/~\000\000\000\000\000\000\014\162;\020\000\000\000\000\000\000\000\000"), (16, "\006\014\003\162\002\r\002\014\001^\0007\002\244\001\191\000\189\006\177\005t\000\193\000\194\005\151\001\239\001\024\001\223\002Q\006\015\006\188\001\227\006\017\001\016\000q\001^\002R\005\153\006\242\002\014\001^\006\018\006\031\001\191\006\014\0060\002\r\002\014\001^\002`\005\203\006/\001\223\001\t\001\252\001\237\001\227\000\193\001\016\001\016\001\019\002Q\006\015\006\030\000\140\006\017\006\163\001\208\001\239\002R\006\019\001\228\005\158\001\t\006\018\006\031\001d\006\234\005\205\001\016\001\019\003\163\002`\001\t\004}\001\229\002\r\002\014\001^\001\016\001\019\003\160\005\234\005\206\004\031\006\183\001\228\001\252\005\208\000\196\000\193\000;\005\252\006\019\006\020\006\235\006\244\006\181\002b\003\158\001\229\004\212\006\021\001\253\001\223\001\191\003\167\001\235\001\227\002\017\001\016\002d\000\193\004\213\001\223\001\t\000\140\004\237\001\227\000\145\001\016\001\016\001\029\005\162\006\128\001\024\006$\006\020\001\025\003\180\002\244\002b\000@\001\020\006\245\006\021\002d\000\193\006\155\001\222\005v\006%\002\017\001!\002d\000\193\001\253\000\196\001\228\001\024\006\024\000\146\001\027\006\190\001\231\006\026\006\158\000\189\001\228\006$\000\193\000\251\000?\001\024\000\140\006\028\001\025\000\149\002e\001+\002k\002\016\001\229\001\030\006%\0007\002q\000:\001}\002g\001\024\006\029\003\171\006\024\002d\000\193\000\251\005\210\006\026\001,\001\027\003\227\002\244\003\161\000\196\001#\001J\006U\006\028\002s\006|\002e\000\196\002k\006\014\000m\002\r\002\014\001^\002q\003\243\001}\002g\000\140\006\029\000\150\001\208\001e\003\161\000\\\001\t\002Q\006\015\006\030\001\t\006\017\001\016\001\019\000`\002R\001\016\001\029\002s\001#\006\018\006\031\006\226\001\t\003\238\003\240\003\242\002e\002`\001\016\001\029\0007\001\024\0007\001\t\002f\0011\001}\002g\000\140\001\016\001\029\000\145\006{\001\t\006_\006\161\006\162\001\t\006\019\001\016\001\019\0007\006t\001\016\001\029\006V\006\227\001\162\001^\001M\001*\003\243\001\016\004\212\001\t\005P\004\001\001\030\001\189\001\024\001\016\001\029\006\130\004\160\006`\004\213\000d\001_\002\"\004\220\001a\001b\006\020\006a\000y\006\014\002b\002\r\002\014\001^\006\021\001\030\002\244\000\129\001'\000\132\001\027\002\017\0017\002d\000\193\004\212\002Q\006\015\006\030\001\030\006\017\006\206\001P\001?\002R\003\210\006\230\004\213\006$\006\018\006\031\004\214\006|\003\130\002\239\002\240\001\030\002`\006^\001\140\001^\001\012\003\246\006%\001\t\0009\001'\001\016\001\t\001A\001\016\001\029\006\024\001\t\001\016\001\019\000\128\006\026\006\019\001\016\001\019\006\231\006S\003\247\000\193\001x\001\"\006\028\001\t\000\196\002e\000\196\002k\006\159\001\016\001\029\001g\003\213\002q\000\193\001}\002g\001\t\006\029\000\140\000\135\006j\001\208\001\016\001\029\000\189\001\231\006\020\000\193\000\194\006\014\002b\002\r\002\014\001^\006\021\002s\001\030\006\160\003\133\003\138\004\212\002\017\003\249\002d\000\193\004\212\002Q\006\015\006\030\000=\006\017\000\167\004\213\001Y\002R\005\203\004\219\004\213\006$\006\018\006\031\004\245\006r\003\252\003\174\001^\000\134\002`\000\189\001z\000\179\000\193\000\194\006%\001\030\006b\006c\001{\001\250\001}\001e\000\196\006\024\005\205\006d\006e\003\227\006\026\006\019\002\237\001^\000\140\006&\000\174\001\208\006f\004\001\006\028\005\206\001\t\002e\001'\002k\005\208\006\207\001\016\001\029\005\231\002q\000\172\001}\002g\001\t\006\029\000\182\002\r\002\014\001^\001\016\001\019\000\189\000\144\006\020\000\193\000\194\006\014\002b\002\r\002\014\001^\006\021\002s\004\229\003\241\003\240\003\242\000\143\002\017\003\158\002d\000\193\002\244\002Q\006\015\006\030\003\167\006\017\000\195\000\176\005?\002R\005\203\001\t\000\165\006$\006\018\006\031\004\232\001\016\001\029\001\250\001\210\000\171\002`\000\193\006b\006c\002\244\003\168\006%\001\024\000\196\004\234\001$\006d\006e\000\196\000\189\006\024\005\205\000\193\000\251\004\208\006\026\006\019\006f\004\001\004\\\006\"\000\252\000\193\001\251\004\235\006\028\005\206\004\140\002e\001\027\002k\005\208\006\254\002\014\001^\005\224\002q\001\212\001}\002g\004 \006\029\002\016\001\016\001\024\000\255\001\024\001\025\004\\\001\025\006\020\000\193\001+\003\171\002b\002d\000\193\000\251\006\021\002s\006\014\001\216\002\r\002\014\001^\002\017\006\173\002d\000\193\005\244\005?\001\027\001,\001\027\007\001\007\002\004\206\002Q\007\004\001H\004\142\006\017\006$\005F\005G\002R\004_\001\215\001}\003\161\006\018\007\006\000\187\001\016\0007\005\247\006\160\006%\002`\005W\003\166\001\t\0007\005P\004\001\001\251\006\024\001\016\001\029\001\217\005\249\006\026\002e\004\143\001#\006\\\001#\001}\000\177\006\019\002f\006\028\001}\002g\002e\000\189\002k\000\189\000\193\000\194\000\193\000\194\002q\0011\001}\002g\005\250\006\029\006\255\006\199\002d\000\193\006\172\001\t\000\181\001\t\002\r\002\014\001^\001\016\001\029\001\016\001\029\006\020\000\196\002s\005\203\002b\000\186\001\030\006\014\006\021\002\r\002\014\001^\007\021\004\142\002\244\002\017\006@\002d\000\193\005F\005G\003\214\007\r\000\189\002Q\007\014\000\193\000\251\006\017\007\t\000\197\005\205\002R\001'\000\204\005O\001\239\006\018\007\022\005P\004\001\0017\002\244\0017\0068\002`\005\206\006%\001\030\002\244\001\030\005\208\004\211\005\198\001?\005\215\006\024\001\239\002\244\003\161\006\200\006\026\001\243\003\223\004\001\001\252\006\019\000\140\000\193\001\195\001\208\006\028\006\214\003\213\002e\001'\002k\001'\001A\002\244\001A\002\246\002q\001\254\001}\002g\001\252\006\029\002\016\000\193\0042\006\201\000\196\006\161\006\162\000\217\006\208\001\016\001\250\002\017\006\020\002d\000\193\004\\\002b\002s\000\193\000\221\006\021\002\245\001]\001^\002w\005P\004\001\002\017\004\007\002d\000\193\006\014\004?\002\r\002\014\001^\001\253\004\131\004\\\004\012\007\026\000\193\001_\002\185\003\227\001a\001b\006\209\002Q\006\015\006,\001\191\006\017\001\232\003\213\002\244\002R\001\253\004$\006%\001\223\006\018\006\031\000\205\001\227\005\238\001\016\000\218\006\024\002`\002e\006\210\003\227\006\026\001\250\004!\001\024\002\244\002f\001\025\001}\002g\006\215\006\028\001}\000\227\002e\000\234\002k\006\211\006\019\0058\003\240\003\242\002q\000\242\001}\002g\000\140\006\029\005)\001\208\001\222\001\027\001\228\006h\001R\001}\001\024\000\189\001\003\001\025\000\193\000\194\004N\001^\001f\002s\001\229\005L\003\240\003\242\004J\001\251\006\020\000\196\001\006\001g\002b\000\196\000\193\001\023\006\021\0014\006\014\001\027\002\r\002\014\001^\002\017\005\203\002d\000\193\005\251\004-\004\191\001#\000\196\002\244\007\r\000\229\002Q\007\014\002\244\000\189\006\017\006$\000\193\000\251\002R\004\194\002\186\000\235\002\244\006\018\007\017\001\157\006o\005\205\005\247\005\210\006%\002`\000\189\003\227\001\t\000\193\000\194\001#\000\238\006\024\001\016\001\029\005\206\005\249\006\026\001z\001\251\005\208\001;\000\255\0047\005\212\006\019\001\150\006\028\001}\001e\002e\004\136\002k\006\137\000\193\002\244\005\203\0007\002q\001\t\001}\002g\005\250\006\029\000\196\001\016\001\029\004\148\001]\001^\004Y\004\001\004\181\005T\003\240\003\242\000\196\001\239\001&\006\020\004k\002s\0043\002b\005\205\001\030\001\016\006\021\001_\001o\001@\001a\001b\000\196\002\017\003\213\002d\000\193\006\014\005\206\002\r\002\014\001^\001\240\005\208\002\244\001\252\007\020\005\209\000\193\0017\004\203\001'\001\239\000\193\002Q\006\015\001\030\001\t\006\017\000\243\004\196\004\221\002R\001\016\001\029\006%\001O\006\018\006(\006\169\001p\001\222\001q\002\192\006\024\002`\001@\001>\002\026\006\026\001\152\001\252\001U\001'\000\193\000\140\001A\0053\001\208\006\028\001\149\001\t\002e\004\236\002k\000m\006\019\001\016\001\029\001<\002q\001x\001}\002g\001\253\006\029\000\189\005\028\004o\000\193\000\251\004\238\001g\001m\001\016\000\193\001V\001\024\004\232\001\024\001\025\000\196\001\025\002s\003\001\001\239\004\215\000\193\000\251\001w\006\020\004<\001\024\004\234\002b\005\029\005]\005\030\006\021\000\196\001\253\001\156\001\196\001\168\001\027\002\017\001\027\002d\000\193\001]\001^\003\197\0039\004\235\001\252\000\193\000\251\000\193\001\t\0069\003\018\000\196\006+\005?\001\016\001\019\005\031\004E\001\t\001_\002\185\001z\001a\001b\001\016\001\029\004\215\006%\000\196\001{\002\244\001}\001e\003\213\002\244\005\247\006\024\001#\003J\001#\001n\006\026\002\244\002\244\004\152\004\001\001\191\003\227\001\192\005 \005\249\006\028\001\179\006\150\002e\001\223\002k\001\173\005!\001\227\005\"\001\016\002q\001\253\001}\002g\001\t\006\029\001\t\002\r\002\014\001^\001\016\001\029\001\016\001\029\005\250\0007\006\136\002\244\001\024\001\t\004\t\005^\002Q\002s\001\181\001\016\001\029\004\002\006~\003\195\002R\001f\006\145\003\240\003\242\004\246\006J\001\228\001\024\0048\000\196\001\025\001g\002`\005$\000\193\001\178\004=\006s\005&\0050\001\229\000\196\005F\005G\0017\001\188\0017\001\024\005Z\005<\004\001\001\030\002\244\001\030\001\027\005_\002\b\005H\005X\002\r\002\014\001^\005P\004\001\005[\003k\001\030\006`\002\244\004\217\001\184\005?\000\193\006\180\002Q\000\196\006a\002\244\001'\002\011\001'\001A\002R\001A\003n\000m\004w\002\025\003\140\004\215\001z\002b\001\016\006|\001\230\002`\001\024\001#\001\150\001\025\001}\001e\002\017\001\201\002d\000\193\001\t\000\196\002(\002\244\001\239\005B\001\016\001\029\002\r\002\014\001^\002+\000\196\004U\001\203\0021\005\193\001\027\002F\000\193\001\t\005{\002K\002Q\001\239\001\024\001\016\001\029\002h\004a\003\205\002R\001@\001\252\005?\000\196\000\193\006\222\004d\001\219\001\t\001\226\000m\000\196\002`\003\188\001\016\001\029\002b\001\024\003\209\003\184\001\025\001\252\002\244\002e\000\193\002k\001\030\002\017\001#\002d\000\193\002q\000\196\001}\002g\005F\005G\005\185\004l\0017\002\163\000\196\006\152\001\239\001\027\000\196\001\030\003\196\000\196\006\224\005H\005X\000\196\001\031\002s\005P\004\001\001\t\002\007\002h\001\253\005?\005\217\001\016\001\029\000\193\001\030\003\202\001\191\004#\001\221\002b\001\252\001'\003\217\000\193\001A\001\223\003\234\002\244\001\253\001\227\002\017\001\016\002d\000\193\002e\001#\002k\004p\005\127\003\236\001\t\001)\002q\003\254\001}\002g\001\016\001\029\001\024\006\166\000\196\001\025\005F\005G\006Z\004\001\0017\000\196\002\n\004\003\001\024\004\"\002h\001\030\001\t\002s\002\024\005H\005X\001\228\001\016\001\029\005P\004\001\004(\001\027\004/\000\196\002'\001\253\002\r\002\014\001^\001\229\000\196\002*\0020\002<\000\196\002e\001'\002k\005?\001A\004x\002Q\0045\002q\001\030\001}\002g\000\196\0029\002R\001\191\000\196\001\247\002\244\004H\006O\004M\005F\005G\001\223\004X\0017\002`\001\227\001#\001\016\002s\000\196\001\030\000\196\002\244\003h\005H\005X\002\r\002\014\001^\005P\004\001\002\r\002\014\001^\000\196\000\189\000\196\004`\000\193\000\194\004c\002Q\002A\004j\004n\001\t\002Q\001'\004s\002R\001A\001\016\001\029\001\239\002R\001\228\000\196\001\t\004\127\006=\004\014\002@\002`\001\016\001\029\004\146\005\203\002`\000\196\001\229\000\196\002E\004\137\002b\000\196\002\r\002\014\001^\002J\004I\002\247\002p\001\252\002\167\002\017\000\193\002d\000\193\004\151\004\141\002Q\002\202\005F\005G\005\205\004\156\0017\002\209\002R\000\196\002\244\004\166\000\196\001\030\004\b\000\196\000\196\006\148\006\149\005\206\000\196\002`\005P\004\001\005\208\001\030\002h\002\238\005\219\002\244\000\196\002b\002\244\002\r\002\014\001^\002b\000\196\004\172\001\239\001'\003]\002\017\001A\002d\000\193\003e\002\017\002Q\002d\000\193\001\253\003\245\002e\002\244\002k\002R\001\191\004\183\002\029\000\196\002q\003\194\001}\002g\006D\001\223\000\196\001\252\002`\001\227\000\193\001\016\000\196\002h\003\154\004\198\004\195\003\164\002h\002b\003\186\004\216\004\202\002s\004\223\001\024\004\240\003\201\005\001\003\203\002\017\004\250\002d\000\193\005\019\004\228\002\244\002\244\004\233\000\196\002e\003\216\003\007\003\253\005(\002e\004\005\002k\002q\001\228\001}\002g\001\027\002q\002\244\001}\002g\004.\002\244\000\196\005\017\004'\002h\001\229\006\014\0052\001\253\002b\002\244\004)\004,\002s\002\r\002\014\001^\004;\002s\000\196\002\017\007\r\002d\000\193\007\014\000\196\000\196\006\017\000\196\002Q\000\196\002e\005>\002k\005R\000\196\006\018\002R\000\196\002q\005b\001}\002g\001\024\0041\005\025\005%\003\191\000\196\005h\002`\005l\002h\004:\005\136\002\r\002\014\001^\002\244\002\r\002\014\001^\002s\005-\002\244\006\019\001\t\005D\005\176\000\196\002Q\005\236\001\016\001\029\002Q\005\181\005\220\005u\002R\002e\002\244\002k\002R\005\186\003\177\0046\002\244\002q\003\129\001}\002g\002`\0049\004G\000\196\002`\000\196\000\189\004L\006\020\000\193\000\194\000\196\002\r\002\014\001^\001\191\006\021\003\207\002b\002s\000\196\005\216\000\196\004T\001\223\000\196\002\244\002Q\001\227\002\017\001\016\002d\000\193\001\030\005\152\002R\007\016\005\203\005\192\000\196\005\178\003|\000\196\002\244\004S\004W\000\196\000\196\002`\005\200\005\241\001\t\006\006\006C\000\196\006\023\005\189\001\016\001\029\002b\001'\002h\005\223\002b\006\024\005\205\004b\002\244\001\228\006\026\002\017\002\244\002d\000\193\002\017\002\244\002d\000\193\002\244\006\028\005\206\002\244\001\229\000\196\002\244\005\208\004m\006]\002e\005\237\003\007\004i\004r\005\235\002\244\006\029\002q\004\134\001}\002g\000\196\006i\002h\006w\001]\001^\002h\002b\002\244\001\030\005\239\000\196\000\196\004z\000\196\000\196\006y\002\244\002\017\002s\002d\000\193\004\133\002\244\001_\001o\004\128\001a\001b\002e\002\244\002k\004\132\002e\005\243\002k\003\251\002q\005\248\001}\002g\002q\006\004\001}\002g\006\011\002\244\003x\006\025\000\196\002h\006 \002\244\002\r\002\014\001^\004\145\002\r\002\014\001^\002s\006)\004\150\000\196\002s\000\196\004\249\001p\002Q\001q\002-\004\155\002Q\004\158\004\162\006n\002R\002e\000\196\002k\002R\004\170\003q\004\177\006\154\002q\003b\001}\002g\002`\006\168\004\188\004\248\002`\004\241\004\242\004\247\007\007\001x\002\r\002\014\001^\004\251\002\r\002\014\001^\004\252\005\027\002s\001g\005\020\005\021\000\193\007\018\002Q\005\026\005/\005+\002Q\007\023\003{\005,\002R\005.\005Y\005=\002R\000\189\003Z\005A\000\193\000\194\001\191\005C\004\022\002`\003R\005E\005Q\002`\005a\001\223\005c\005d\005i\001\227\005m\001\016\002b\001]\001^\005q\002b\005\131\005\138\005\142\005\166\005\187\005\203\002\017\005\211\002d\000\193\002\017\005\221\002d\000\193\006\r\001z\001_\001`\006\007\001a\001b\006\b\006\012\001{\006\027\001}\001e\006B\006M\006X\006l\006m\001\228\005\205\006q\006\153\006\157\006\167\002h\006\171\005\028\002b\002h\006\249\000\000\002b\001\229\000\000\005\206\002\r\002\014\001^\002\017\005\208\002d\000\193\002\017\006\000\002d\000\193\000\000\000\000\000\000\000\000\002Q\002e\000\000\002k\005\029\002e\005\030\002k\002R\002q\000\000\001}\002g\002q\002]\001}\002g\000\000\000\000\000\000\002h\002`\000\000\000\000\002h\000\000\001f\002\r\002\014\001^\000\000\000\000\002s\000\000\000\000\005\031\002s\001g\000\000\000\000\000\193\000\000\002Q\000\000\000\000\000\000\000\000\002e\000\000\002k\002R\002e\000\000\003\007\000\000\002q\002j\001}\002g\002q\000\000\001}\002g\002`\000\000\000\000\000\000\000\000\005 \002\r\002\014\001^\000\000\000\000\002\r\002\014\001^\005!\002s\005\"\002b\000\000\002s\000\000\002Q\000\000\001\191\000\000\004\026\002Q\000\000\002\017\002R\002d\000\193\001\223\001z\002R\002y\001\227\000\000\001\016\005\\\002x\001\150\002`\001}\001e\000\000\000\000\002`\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\r\002\014\001^\002b\002h\000\000\005$\000\000\000\000\000\000\000\000\005&\0050\000\000\002\017\002Q\002d\000\193\000\000\000\000\001\228\005Z\000\000\002R\000\000\000\000\000\000\000\000\000\000\002\172\000\000\002e\000\000\002k\001\229\000\000\002`\005[\000\000\002q\000\000\001}\002g\000\000\000\000\002b\002h\000\000\000\000\000\000\002b\000\000\000\000\002\r\002\014\001^\002\017\000\000\002d\000\193\000\000\002\017\002s\002d\000\193\001\191\000\000\004\029\002Q\000\000\000\000\000\000\000\000\002e\001\223\002k\002R\000\000\001\227\000\000\001\016\002q\002\183\001}\002g\000\000\000\000\000\000\002h\002`\000\000\000\000\000\000\002h\000\000\002b\000\000\000\000\002\r\002\014\001^\001\191\000\000\004+\002s\000\000\002\017\000\000\002d\000\193\001\223\000\000\000\000\002Q\001\227\002e\001\016\002k\001\228\000\000\002e\002R\002k\002q\000\000\001}\002g\002\206\002q\000\000\001}\002g\001\229\000\000\002`\002\r\002\014\001^\002h\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002s\000\000\002b\000\000\000\000\002s\000\000\000\000\001\228\000\000\000\000\000\000\003M\002\017\000\000\002d\000\193\001\024\000\000\002e\005\b\002k\001\229\002\r\002\014\001^\000\000\002q\000\000\001}\002g\000\000\000\000\000\000\000\000\000\000\003N\000\000\002Q\000\000\000\000\002\r\002\014\001^\001\027\002h\002R\002b\000\000\000\000\002s\000\000\002\213\001\191\000\000\004|\002Q\000\000\002\017\002`\002d\000\193\001\223\000\000\002R\000\000\001\227\000\000\001\016\000\000\002\216\000\000\002e\000\000\002k\006\014\000\000\002`\000\000\000\000\002q\000\000\001}\002g\002\016\002\r\002\014\001^\000\000\000\000\002h\000\000\000\000\006\015\000\000\002\017\006\017\002d\000\193\000\000\002Q\000\000\000\000\002s\000\000\006\018\001\228\000\000\002R\000\000\000\000\000\000\000\000\000\000\002\222\000\000\001\t\002e\002b\002k\001\229\002`\001\016\001\029\000\000\002q\000\000\001}\002g\002\017\003P\002d\000\193\000\000\006\019\000\000\002b\002\r\002\014\001^\000\000\000\000\001\191\000\000\004\130\000\000\000\000\002\017\002s\002d\000\193\001\223\002Q\000\000\002e\001\227\000\000\001\016\000\000\000\000\002R\002h\002f\000\000\001}\002g\002\225\000\000\006\020\000\000\000\000\000\000\000\000\002`\001\030\000\000\006\021\000\000\000\000\002h\002b\000\000\002\r\002\014\001^\000\000\000\000\000\000\002e\000\000\002k\002\017\000\000\002d\000\193\001\228\002q\002Q\001}\002g\006\022\001'\000\000\000\000\000\000\002R\002e\000\000\002k\001\229\000\000\002\250\000\000\000\000\002q\006\023\001}\002g\002`\002s\000\000\000\000\000\000\002h\006\024\000\000\002\r\002\014\001^\006\026\000\000\000\000\002b\002\r\002\014\001^\000\000\002s\000\000\006\028\000\000\002Q\000\000\002\017\000\000\002d\000\193\000\000\002Q\002R\002e\000\000\002k\000\000\000\000\006\029\002R\000\000\002q\003\004\001}\002g\002`\000\000\000\000\000\000\003\t\000\000\000\000\002`\000\000\002\r\002\014\001^\000\000\002h\000\000\002b\002\r\002\014\001^\002s\000\000\001\191\000\000\004\139\000\000\000\000\002\017\000\000\002d\000\193\001\223\002Q\003M\000\000\001\227\000\000\001\016\000\000\000\000\002R\002e\000\000\002k\000\000\000\000\000\000\000\000\000\000\002q\003\011\001}\002g\002`\000\000\000\000\000\000\005\207\000\000\002h\002b\000\000\000\000\000\000\000\000\000\000\000\000\002b\002\r\002\014\001^\002\017\002s\002d\000\193\001\228\000\000\000\000\002\017\000\000\002d\000\193\000\000\002Q\000\000\000\000\002e\000\000\002k\001\229\000\000\002R\000\000\000\000\002q\000\000\001}\002g\000\000\000\000\000\000\003\015\000\000\002h\002`\002\016\000\000\000\000\000\000\000\000\002h\000\000\002b\002\r\002\014\001^\002\017\002s\002d\000\193\002\r\002\014\001^\002\017\000\000\002d\000\193\000\000\002Q\000\000\002e\000\000\003\007\000\000\000\000\002Q\002R\002e\002q\003\007\001}\002g\000\000\002R\000\000\002q\003\023\001}\002g\002`\000\000\003P\000\000\003\029\000\000\002h\002`\000\000\000\000\000\000\000\000\002s\000\000\002b\002\r\002\014\001^\000\000\002s\000\000\000\000\000\000\000\000\000\000\002\017\002e\002d\000\193\000\000\002Q\000\000\000\000\002e\002f\003\007\001}\002g\002R\000\000\001\191\002q\004\147\001}\002g\000\000\000\000\000\000\003#\001\223\000\000\002`\000\000\001\227\000\000\001\016\000\000\002h\000\000\002b\002\r\002\014\001^\000\000\002s\000\000\002b\000\000\000\000\000\000\002\017\000\000\002d\000\193\000\000\002Q\000\000\002\017\000\000\002d\000\193\000\000\000\000\002R\002e\000\000\003\007\000\000\000\000\003+\000\000\000\000\002q\001\228\001}\002g\002`\000\000\000\000\002\r\002\014\001^\002h\000\000\000\000\000\000\000\000\001\229\000\000\002h\002b\000\000\000\000\000\000\002Q\002s\000\000\000\000\000\000\000\000\000\000\002\017\002R\002d\000\193\000\000\000\000\000\000\0030\002e\000\000\003\007\000\000\000\000\000\000\002`\002e\002q\003\007\001}\002g\000\000\000\000\000\000\002q\000\000\001}\002g\001\191\000\000\006H\000\000\000\000\002h\000\000\002b\000\000\001\223\000\000\000\000\002s\001\227\000\000\001\016\000\000\000\000\002\017\002s\002d\000\193\002\r\002\014\001^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002e\000\000\003'\000\000\000\000\002Q\000\000\000\000\002q\000\000\001}\002g\000\000\002R\002b\002\r\002\014\001^\002h\000\000\000\000\001\228\000\000\003<\000\000\002\017\002`\002d\000\193\000\000\002Q\002s\000\000\000\000\000\000\001\229\000\000\000\000\002R\002\r\002\014\001^\000\000\000\000\000\000\002e\000\000\002k\003A\000\000\000\000\002`\000\000\002q\002Q\001}\002g\002h\000\000\000\000\000\000\000\000\002R\000\000\002\r\002\014\001^\000\000\000\000\000\000\000\000\000\000\003F\000\000\000\000\002`\002s\000\000\000\000\002Q\000\000\000\000\000\000\000\000\002e\002b\002k\002R\000\000\002\r\002\014\001^\002q\000\000\001}\002g\002\017\003U\002d\000\193\002`\000\000\000\000\000\000\002Q\000\000\000\000\000\000\000\000\000\000\002b\000\000\002R\000\000\000\000\002s\000\000\000\000\000\000\000\000\000\000\002\017\003X\002d\000\193\002`\000\000\000\000\002h\000\000\000\000\000\000\000\000\000\000\002b\002\r\002\014\001^\000\000\002\r\002\014\001^\000\000\000\000\000\000\002\017\000\000\002d\000\193\000\000\002Q\000\000\000\000\002h\002Q\002e\000\000\003\007\002R\002b\000\000\000\000\002R\002q\003^\001}\002g\000\000\003`\000\000\002\017\002`\002d\000\193\000\000\002`\000\000\002h\000\000\000\000\002e\000\000\003\007\000\000\002b\000\000\002s\000\000\002q\000\000\001}\002g\000\000\000\000\000\000\002\017\000\000\002d\000\193\000\000\000\000\000\000\002h\000\000\002e\000\000\003\007\000\000\000\000\000\000\000\000\002s\002q\000\000\001}\002g\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002h\000\000\002e\002b\003\007\000\000\000\000\002b\002s\000\000\002q\000\000\001}\002g\002\017\000\000\002d\000\193\002\017\000\000\002d\000\193\000\000\000\000\002\r\002\014\001^\002e\000\000\003'\000\000\000\000\000\000\002s\000\000\002q\000\000\001}\002g\002Q\002\r\002\014\001^\000\000\000\000\000\000\002h\002R\000\000\000\000\002h\000\000\000\000\003j\000\000\002Q\000\000\000\000\002s\000\000\002`\000\000\000\000\002R\000\000\000\000\002\r\002\014\001^\003s\000\000\000\000\000\000\002e\000\000\002k\002`\002e\000\000\002k\000\000\002q\000\000\001}\002g\002q\000\000\001}\002g\003\175\000\000\000\000\000\000\000\000\000\000\002\r\002\014\001^\000\000\000\000\002\r\002\014\001^\000\000\002s\000\000\000\000\000\000\002s\000\000\002Q\000\000\000\000\000\000\000\000\002Q\000\000\000\000\002R\002b\000\000\000\000\000\000\002R\003v\000\000\000\000\000\000\000\000\003\132\002\017\002`\002d\000\193\000\000\002b\002`\000\000\000\000\000\000\002\r\002\014\001^\000\000\000\000\000\000\002\017\000\000\002d\000\193\000\000\000\000\000\000\000\000\000\000\002Q\000\000\000\000\000\000\000\000\000\000\002\016\002h\002R\000\000\000\000\000\000\000\000\000\000\003\135\000\000\000\000\002\017\000\000\002d\000\193\002`\000\000\002h\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002e\002b\002k\000\000\000\000\000\000\002b\000\000\002q\000\000\001}\002g\002\017\000\000\002d\000\193\002e\002\017\002k\002d\000\193\000\000\000\000\000\000\002q\000\000\001}\002g\002\r\002\014\001^\002s\000\000\002\r\002\014\001^\000\000\000\000\000\000\000\000\000\000\000\000\002e\002Q\002h\000\000\002b\002s\002Q\002h\002f\002R\001}\002g\000\000\000\000\002R\002\017\000\000\002d\000\193\003\145\000\000\000\000\002`\000\000\003\150\000\000\000\000\002`\000\000\002e\000\000\002k\000\000\000\000\002e\000\000\002k\002q\000\000\001}\002g\000\000\002q\000\000\001}\002g\000\000\002h\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002s\000\000\000\000\000\000\000\000\002s\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002e\000\000\002k\000\000\000\000\000\000\006\014\002b\002q\000\000\001}\002g\002b\000\000\000\000\002\r\002\014\001^\002\017\000\000\002d\000\193\000\000\002\017\006\015\002d\000\193\006\017\000\000\000\000\002Q\002s\000\000\002\r\002\014\001^\006\018\000\000\002R\000\000\000\000\000\000\000\000\000\000\003\199\000\000\000\000\000\000\002Q\000\000\002h\002`\000\000\000\000\000\000\002h\002R\000\000\000\000\000\000\000\000\000\000\003\212\000\000\000\000\006\019\002\r\002\014\001^\002`\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002e\000\000\003\007\000\000\002Q\002e\000\000\003\007\002q\000\000\001}\002g\002R\002q\000\000\001}\002g\000\000\004\000\000\000\000\000\000\000\006\020\000\000\000\000\002`\000\000\000\000\000\000\000\000\006\021\002s\000\000\002b\000\000\000\000\002s\000\000\002\r\002\014\001^\000\000\000\000\000\000\002\017\000\000\002d\000\193\000\000\000\000\000\000\002b\000\000\002Q\006!\000\000\000\000\000\000\000\000\000\000\000\000\002R\002\017\000\000\002d\000\193\000\000\004C\000\000\006\023\000\000\000\000\000\000\000\000\002`\000\000\002h\000\000\006\024\000\000\000\000\000\000\000\000\006\026\002b\000\000\000\000\000\000\000\000\002\r\002\014\001^\000\000\006\028\002h\002\017\000\000\002d\000\193\000\000\000\000\000\000\000\000\002e\002Q\002k\000\000\000\000\000\000\006\029\000\000\002q\002R\001}\002g\001]\001^\000\000\005p\000\000\000\000\002e\000\000\002k\000\000\002`\000\000\002h\000\000\002q\000\000\001}\002g\002b\002s\001_\001o\000\000\001a\001b\000\000\000\000\000\000\000\000\002\017\000\000\002d\000\193\000\000\000\000\000\000\000\000\002s\000\000\002e\000\000\002k\000\000\004\016\000\000\000\000\000\000\002q\000\000\001}\002g\000\000\000\000\000\000\001\024\000\000\000\000\005\005\000\000\000\000\000\000\002h\000\000\001p\000\000\001q\002-\000\000\000\000\002b\002s\000\000\000\000\000\000\002\r\002\014\001^\000\000\000\000\000\000\002\017\001\027\002d\000\193\000\000\000\000\000\000\000\000\002e\002Q\002k\002\r\002\014\001^\001x\000\000\002q\002R\001}\002g\000\000\000\000\000\000\005s\000\000\001g\002Q\000\000\000\193\000\000\002`\000\000\002h\000\000\002R\000\000\003{\000\000\000\000\002s\005\130\000\000\000\000\000\000\005\007\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\002e\000\000\002k\000\000\000\000\000\000\000\000\000\000\002q\000\000\001}\002g\000\000\000\000\001\t\000\000\000\000\000\000\000\000\000\000\001\016\005\n\000\000\000\000\000\000\001z\000\000\002\r\002\014\001^\002b\002s\000\000\001{\000\000\001}\001e\000\000\000\000\000\000\000\000\002\017\002Q\002d\000\193\000\000\000\000\002b\000\000\000\000\002R\002\r\002\014\001^\000\000\000\000\005\133\000\000\002\017\000\000\002d\000\193\000\000\002`\000\000\000\000\002Q\000\000\002\r\002\014\001^\000\000\005\011\002h\002R\000\000\000\000\000\000\000\000\000\000\005\146\000\000\001\024\002Q\004\213\001\025\005\016\002`\005\r\000\000\002h\002R\000\000\000\000\000\000\000\000\000\000\005\149\000\000\001'\002e\000\000\002k\000\000\002`\000\000\000\000\000\000\002q\001\027\001}\002g\000\000\000\000\000\000\000\000\000\000\002e\000\000\002k\000\000\000\000\002b\000\000\000\000\002q\000\000\001}\002g\000\000\000\000\002s\000\000\002\017\000\000\002d\000\193\000\000\000\000\000\000\000\000\000\000\000\000\002\r\002\014\001^\002b\000\000\002s\000\000\000\000\000\000\001#\000\000\000\000\000\000\000\000\002\017\002Q\002d\000\193\000\000\000\000\002b\000\000\002h\002R\000\000\002\r\002\014\001^\000\000\005\170\000\000\002\017\000\000\002d\000\193\000\000\002`\000\000\001\t\000\000\002Q\002\r\002\014\001^\001\016\001\029\002h\000\000\002R\002e\000\000\002k\000\000\000\000\005\173\000\000\002Q\002q\000\000\001}\002g\002`\000\000\002h\002R\000\000\000\000\000\000\000\000\000\000\005\177\000\000\000\000\002e\000\000\002k\000\000\002`\000\000\000\000\002s\002q\000\000\001}\002g\000\000\000\000\000\000\000\000\0017\002e\000\000\002k\000\000\006\014\002b\001\030\000\000\002q\000\000\001}\002g\000\000\000\000\002s\000\000\002\017\000\000\002d\000\193\000\000\000\000\006\015\000\000\000\000\006\017\000\000\000\000\000\000\000\000\002b\002s\000\000\001'\006\018\000\000\0018\000\000\000\000\000\000\000\000\002\017\000\000\002d\000\193\000\000\002b\000\000\002h\000\000\000\000\002\r\002\014\001^\000\000\000\000\000\000\002\017\000\000\002d\000\193\000\000\000\000\006\019\000\000\000\000\002Q\000\000\000\000\000\000\001]\001^\000\000\002h\002R\002e\000\000\002k\000\000\000\000\006\184\000\000\000\000\002q\000\000\001}\002g\002`\000\000\002h\001_\001o\000\000\001a\001b\000\000\000\000\006\020\000\000\000\000\002e\000\000\002k\000\000\000\000\006\021\002s\000\000\002q\000\000\001}\002g\000\000\006R\000\000\000\000\002e\000\000\002k\000\000\000\000\000\000\000\000\000\000\002q\000\000\001}\002g\000\000\006*\000\000\002s\000\000\001p\000\000\001q\002-\000\000\000\000\000\000\002\r\002\014\001^\000\000\006\023\000\000\002b\002s\000\000\000\000\000\000\000\000\000\000\006\024\000\000\002Q\000\000\002\017\006\026\002d\000\193\000\000\000\000\002R\001x\002\r\002\014\001^\006\028\006\186\000\000\000\000\000\000\000\000\000\000\001g\002`\000\000\000\193\000\000\002Q\002\r\002\014\001^\006\029\000\000\003{\000\000\002R\002h\000\000\001]\001^\000\000\000\000\000\000\002Q\000\000\000\000\000\000\000\000\002`\000\000\000\000\002R\001\024\000\000\000\000\005\005\000\000\000\000\001_\001o\000\000\001a\001b\002e\002`\002k\000\000\000\000\001\159\000\000\000\000\002q\000\000\001}\002g\000\000\000\000\000\000\000\000\001\027\000\000\001z\002b\000\000\000\000\000\000\000\000\000\000\000\000\001{\000\000\001}\001e\002\017\002s\002d\000\193\000\000\000\000\000\000\000\000\001p\000\000\001q\001\146\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\002\017\000\000\002d\000\193\005\007\002b\000\000\002h\000\000\000\000\000\000\000\000\000\000\000\000\001x\000\000\002\017\000\000\002d\000\193\000\000\000\000\000\000\000\000\000\000\001g\000\000\000\000\000\193\000\000\000\000\000\000\002h\001\t\002e\000\000\002k\000\000\000\000\001\016\005\n\000\000\002q\000\000\001}\002g\000\000\000\000\002h\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002e\000\000\004\017\000\000\000\000\000\000\002s\000\000\002q\000\000\001}\002g\000\000\000\000\000\000\000\000\002e\000\000\004\r\001]\001^\000\000\000\000\000\000\002q\001z\001}\002g\000\000\000\000\000\000\002s\005\011\001{\000\000\001}\001e\001]\001^\001_\001o\000\000\001a\001b\004\213\000\000\005\015\002s\005\r\001\143\000\000\002\r\002\014\001^\000\000\000\000\000\000\001_\001o\001'\001a\001b\000\000\000\000\000\000\000\000\002Q\001\148\000\000\001]\001^\000\000\000\000\000\000\002R\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001p\000\000\001q\001\146\000\000\002`\000\000\001_\001o\000\000\001a\001b\000\000\000\000\000\000\002\r\002\014\001^\001p\000\000\001q\001\146\000\000\001]\001^\000\000\000\000\000\000\000\000\000\000\002Q\001x\000\000\000\000\000\000\000\000\000\000\000\000\002R\000\000\000\000\000\000\001g\001_\001o\000\193\001a\001b\000\000\001x\001p\002`\001q\002-\000\000\000\000\000\000\000\000\000\000\000\000\001g\000\000\000\000\000\193\002b\000\000\000\000\000\000\002\r\002\014\001^\000\000\000\000\000\000\000\000\002\017\000\000\002d\000\193\000\000\000\000\001x\000\000\002Q\000\000\000\000\001p\000\000\001q\0025\000\000\002R\001g\000\000\000\000\000\193\000\000\000\000\000\000\000\000\000\000\001z\000\000\003w\002`\000\000\000\000\002h\000\000\001{\002b\001}\001e\000\000\000\000\000\000\000\000\001x\000\000\001z\000\000\002\017\000\000\002d\000\193\000\000\000\000\001{\001g\001}\001e\000\193\000\000\000\000\002e\000\000\003\183\000\000\000\000\000\000\000\000\000\000\002q\000\000\001}\002g\000\000\000\000\000\000\000\000\000\000\001z\000\000\002h\000\000\000\000\000\000\000\000\0028\001{\000\000\001}\001e\002b\000\000\002s\002\r\002\014\001^\000\000\000\000\002\r\002\014\001^\002\017\000\000\002d\000\193\000\000\000\000\002e\002Q\003Q\000\000\000\000\000\000\002Q\001z\002q\002R\001}\002g\000\000\000\000\002R\001{\000\000\001}\001e\000\000\000\000\000\000\002`\000\000\000\000\000\000\002h\002`\000\000\000\000\000\000\002s\000\000\002\r\002\014\001^\000\000\002\r\002\014\001^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002Q\000\000\000\000\000\000\002Q\002e\000\000\002\248\002R\000\000\000\000\000\000\002R\002q\000\000\001}\002g\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\002b\000\000\000\000\002s\000\000\002b\000\000\000\000\000\000\000\000\000\000\002\017\000\000\002d\000\193\000\000\002\017\000\000\002d\000\193\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\r\002\014\001^\000\000\002\r\002\014\001^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002Q\002h\000\000\000\000\002Q\002b\002h\000\000\002R\002b\000\000\000\000\002R\000\000\000\000\000\000\002\017\000\000\002d\000\193\002\017\002`\002d\000\193\000\000\002`\000\000\000\000\002e\000\000\002m\000\000\000\000\002e\000\000\002o\002q\000\000\001}\002g\000\000\002q\000\000\001}\002g\000\000\000\000\000\000\002h\000\000\000\000\000\000\002h\000\000\000\000\000\000\000\000\000\000\000\000\002s\000\000\000\000\000\000\000\000\002s\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002e\000\000\002t\000\000\002e\002b\002{\000\000\002q\002b\001}\002g\002q\000\000\001}\002g\002\017\000\000\002d\000\193\002\017\000\000\002d\000\193\002\r\002\014\001^\000\000\002\r\002\014\001^\002s\000\000\000\000\000\000\002s\000\000\000\000\000\000\002Q\002\r\002\014\001^\002Q\000\000\000\000\000\000\002R\002h\000\000\000\000\002R\002h\000\000\000\000\002Q\000\000\000\000\000\000\000\000\002`\000\000\000\000\002R\002`\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002e\002`\002}\000\000\002e\000\000\002\127\000\000\002q\000\000\001}\002g\002q\000\000\001}\002g\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\r\002\014\001^\002s\000\000\000\000\000\000\002s\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002Q\002b\000\000\000\000\000\000\002b\000\000\000\000\002R\000\000\000\000\000\000\002\017\000\000\002d\000\193\002\017\002b\002d\000\193\000\000\002`\000\000\000\000\000\000\000\000\000\000\000\000\002\017\000\000\002d\000\193\002\r\002\014\001^\000\000\002\r\002\014\001^\000\000\000\000\000\000\000\000\000\000\002h\000\000\000\000\002Q\002h\000\000\000\000\002Q\000\000\000\000\000\000\002R\000\000\000\000\000\000\002R\002h\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002`\000\000\000\000\002e\002`\002\129\000\000\002e\000\000\002\131\000\000\002q\002b\001}\002g\002q\000\000\001}\002g\002e\000\000\002\133\000\000\002\017\000\000\002d\000\193\002q\000\000\001}\002g\000\000\000\000\000\000\002s\000\000\000\000\000\000\002s\002\r\002\014\001^\000\000\002\r\002\014\001^\000\000\000\000\000\000\000\000\002s\000\000\000\000\000\000\002Q\002h\000\000\000\000\002Q\002b\000\000\000\000\002R\002b\000\000\000\000\002R\000\000\000\000\000\000\002\017\000\000\002d\000\193\002\017\002`\002d\000\193\000\000\002`\000\000\000\000\002e\000\000\002\135\002\r\002\014\001^\000\000\000\000\002q\000\000\001}\002g\000\000\000\000\001\024\000\000\000\000\001\025\002Q\000\000\002h\000\000\000\000\000\000\002h\000\000\002R\000\000\000\000\000\000\000\000\002s\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002`\000\000\001\027\000\000\006\133\000\000\000\000\000\000\002e\000\000\002\137\000\000\002e\002b\002\139\000\000\002q\002b\001}\002g\002q\000\000\001}\002g\002\017\000\000\002d\000\193\002\017\000\000\002d\000\193\000\000\000\000\000\000\002\r\002\014\001^\000\000\002s\002\r\002\014\001^\002s\000\000\001#\000\000\000\000\000\000\000\000\002Q\000\000\000\000\000\000\000\000\002Q\002h\000\000\002R\002b\002h\000\000\000\000\002R\000\000\000\000\000\000\000\000\000\000\000\000\002\017\002`\002d\000\193\001\t\000\000\002`\000\000\000\000\000\000\001\016\001\029\000\000\002e\000\000\002\141\000\000\002e\000\000\002\143\000\000\002q\000\000\001}\002g\002q\000\000\001}\002g\000\000\000\000\000\000\002h\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\r\002\014\001^\002s\000\000\000\000\000\000\002s\000\000\000\000\000\000\000\000\000\000\000\000\0017\002Q\000\000\000\000\002e\002b\002\145\001\030\000\000\002R\002b\006\140\002q\000\000\001}\002g\002\017\000\000\002d\000\193\000\000\002\017\002`\002d\000\193\000\000\002\r\002\014\001^\000\000\000\000\002\r\002\014\001^\001'\002s\000\000\001A\000\000\000\000\000\000\002Q\000\000\000\000\000\000\000\000\002Q\000\000\002h\002R\000\000\000\000\000\000\002h\002R\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002`\000\000\000\000\000\000\000\000\002`\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002e\000\000\002\147\000\000\000\000\002e\002b\002\149\002q\000\000\001}\002g\000\000\002q\000\000\001}\002g\002\017\000\000\002d\000\193\000\000\000\000\000\000\000\000\000\000\000\000\002\r\002\014\001^\000\000\002s\000\000\000\000\000\000\000\000\002s\000\000\000\000\000\000\000\000\000\000\002Q\000\000\000\000\000\000\002b\000\000\000\000\002h\002R\002b\000\000\000\000\000\000\000\000\000\000\002\017\000\000\002d\000\193\000\000\002\017\002`\002d\000\193\000\000\002\r\002\014\001^\000\000\000\000\000\000\000\000\000\000\000\000\002e\000\000\002\151\000\000\000\000\000\000\002Q\000\000\002q\000\000\001}\002g\000\000\002h\002R\000\000\000\000\000\000\002h\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002`\000\000\000\000\000\000\002s\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002e\000\000\002\153\000\000\000\000\002e\002b\002\155\002q\000\000\001}\002g\000\000\002q\000\000\001}\002g\002\017\000\000\002d\000\193\000\000\002\r\002\014\001^\000\000\000\000\000\000\000\000\000\000\000\000\002s\000\000\000\000\000\000\000\000\002s\002Q\000\000\000\000\000\000\002\164\001^\000\000\000\000\002R\002b\000\000\000\000\002h\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\017\002`\002d\000\193\002\218\001o\000\000\001a\001b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001]\001^\000\000\002e\000\000\002\157\000\000\000\000\000\000\002\181\000\000\002q\000\000\001}\002g\000\000\002h\002\184\001]\001^\001_\002\185\000\000\001a\001b\000\000\000\000\002\181\000\000\000\000\002\223\002\239\002\240\000\000\002s\002\184\000\000\000\000\001_\002\185\000\000\001a\001b\002e\002b\002\159\002\r\002\014\001^\000\000\000\000\002q\000\000\001}\002g\002\017\000\000\002d\000\193\000\000\006\014\002Q\001x\000\000\000\000\000\000\000\000\000\000\000\000\002R\000\000\000\000\000\000\001g\002s\007\r\000\193\000\000\007\014\000\000\000\000\006\017\002`\000\000\000\000\000\000\000\000\002h\000\000\000\000\006\018\000\000\000\000\000\000\001f\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001g\002\243\000\000\000\193\000\000\000\000\000\000\001f\000\000\002e\000\000\002\161\000\000\000\000\006\019\000\000\000\000\002q\001g\001}\002g\000\193\000\000\000\000\000\000\000\000\000\000\001z\000\000\000\000\002\r\002\014\001^\000\000\002\186\001{\002b\001}\001e\000\000\002s\001\024\000\000\000\000\005\005\002Q\000\000\002\017\006\020\002d\000\193\000\000\002\186\002R\002\188\000\000\006\021\000\000\000\000\001z\000\000\000\000\000\000\002\r\002\014\001^\002`\001\150\001\027\001}\001e\000\000\002\187\000\000\000\000\000\000\007\015\001z\002Q\002h\000\000\000\000\002\r\002\014\001^\001\150\002R\001}\001e\000\000\000\000\000\000\000\000\000\000\000\000\006\023\000\000\002Q\000\000\002`\000\000\000\000\000\000\000\000\006\024\002R\002e\000\000\002\254\006\026\000\000\005\007\000\000\000\000\002q\000\000\001}\002g\002`\006\028\000\000\000\000\000\000\000\000\000\000\002b\002\r\002\014\001^\000\000\000\000\000\000\000\000\000\000\000\000\006\029\002\017\002s\002d\000\193\001\t\002Q\002\r\002\014\001^\000\000\001\016\005\n\000\000\002R\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002Q\002b\000\000\000\000\000\000\002`\000\000\000\000\002R\000\000\000\000\002h\002\017\000\000\002d\000\193\000\000\000\000\000\000\000\000\002b\002`\000\000\000\000\002\r\002\014\001^\000\000\000\000\000\000\000\000\002\017\000\000\002d\000\193\000\000\000\000\000\000\002e\002Q\003\027\005\011\000\000\000\000\002h\000\000\002q\002R\001}\002g\000\000\000\000\000\000\004\213\000\000\005\014\000\000\005\r\000\000\000\000\002`\000\000\000\000\002h\002b\000\000\000\000\000\000\001'\002s\000\000\002e\000\000\003!\000\000\002\017\005\028\002d\000\193\002q\002b\001}\002g\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002e\002\017\003&\002d\000\193\002\r\002\014\001^\002q\000\000\001}\002g\002s\000\000\005\029\006\192\005\030\002h\000\000\000\000\002Q\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002R\002b\000\000\002s\000\000\002h\000\000\000\000\000\000\000\000\000\000\000\000\002\017\002`\002d\000\193\002e\005\031\003.\000\000\000\000\000\000\000\000\000\000\002q\000\000\001}\002g\000\000\000\000\000\000\000\000\002e\000\000\0033\000\000\000\000\000\000\000\000\000\000\002q\000\000\001}\002g\002h\000\000\000\000\002s\000\000\000\000\005 \002\r\002\014\001^\000\000\000\000\000\000\000\000\000\000\005!\000\000\005\"\000\000\002s\000\000\000\000\002Q\000\000\000\000\000\000\000\000\002e\002b\0035\002R\002\r\002\014\001^\000\000\002q\000\000\001}\002g\002\017\005^\002d\000\193\002`\000\000\000\000\002Q\002\r\002\014\001^\000\000\000\000\001\024\000\000\002R\001\025\000\000\000\000\002s\002\r\002\014\001^\002Q\005$\006\194\001]\001^\002`\005&\0050\002R\002h\000\000\000\000\002Q\000\000\000\000\000\000\005Z\001\027\000\000\000\000\002R\002`\000\000\001_\001o\000\000\001a\001b\000\000\000\000\000\000\000\000\005[\002`\000\000\000\000\002e\000\000\0038\000\000\002b\000\000\000\000\000\000\002q\000\000\001}\002g\002\r\002\014\001^\002\017\000\000\002d\000\193\000\000\000\000\000\000\006\014\000\000\001#\000\000\000\000\002Q\002b\000\000\001p\002s\001q\002-\000\000\002R\000\000\007\r\000\000\002\017\007\014\002d\000\193\006\017\002b\000\000\000\000\002h\002`\000\000\000\000\000\000\006\018\001\t\000\000\002\017\002b\002d\000\193\001\016\001\029\001x\000\000\000\000\000\000\000\000\000\000\002\017\000\000\002d\000\193\002h\001g\000\000\002e\000\193\003?\000\000\000\000\000\000\000\000\006\019\002q\003z\001}\002g\000\000\002h\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002e\002h\003D\000\000\000\000\000\000\006\132\002s\002q\002b\001}\002g\000\000\001\030\000\000\000\000\002e\006\020\003I\000\000\002\017\000\000\002d\000\193\002q\006\021\001}\002g\002e\000\000\003L\002s\000\000\001z\002\164\001^\002q\000\000\001}\002g\001'\001{\000\000\001}\001e\007\019\000\000\002s\002\r\002\014\001^\000\000\002h\000\000\002\218\001o\000\000\001a\001b\002s\000\000\000\000\000\000\002Q\006\023\000\000\000\000\000\000\000\000\000\000\000\000\002R\000\000\006\024\000\000\000\000\000\000\000\000\006\026\002e\000\000\003~\002\164\001^\002`\000\000\000\000\002q\006\028\001}\002g\000\000\000\000\000\000\000\000\000\000\002\223\002\239\002\240\002\164\001^\000\000\002\218\001o\006\029\001a\001b\000\000\000\000\000\000\002s\002\164\001^\000\000\000\000\000\000\000\000\001]\001^\002\218\001o\000\000\001a\001b\000\000\000\000\000\000\000\000\001x\000\000\000\000\002\218\001o\000\000\001a\001b\000\000\001_\001o\001g\001a\001b\000\193\002b\002\223\002\239\002\240\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\017\000\000\002d\000\193\002\r\002\014\001^\002\223\002\239\002\240\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\137\002\223\002\239\002\240\001x\000\000\000\000\000\000\001p\002\015\001q\006\238\000\000\006\240\002h\001g\000\000\000\000\000\193\000\000\000\000\001x\000\000\000\000\000\000\000\000\001z\000\000\000\000\000\000\000\000\000\000\001g\001x\001{\000\193\001}\001e\000\000\001x\000\000\002e\000\000\003\128\001g\000\000\000\000\000\193\004\006\002q\001g\001}\002g\000\193\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\188\001]\001^\000\000\000\000\000\000\000\000\002s\000\000\001z\000\000\000\000\005\222\000\000\000\000\000\000\002\016\001{\000\000\001}\001e\001_\001o\000\000\001a\001b\001z\002\017\000\000\002d\000\193\000\000\000\000\000\000\001{\000\000\001}\001e\001z\000\000\000\000\000\000\000\000\000\000\001z\000\000\001{\001\024\001}\001e\001\025\000\000\001{\001+\001}\001e\001\024\000\000\000\000\001\025\000\000\000\000\001+\000\000\001p\000\000\001q\0063\000\000\000\000\000\000\000\000\000\000\001,\001\027\000\000\000\000\000\000\000\000\000\000\001-\000\000\001,\001\027\001]\001^\002e\000\000\000\000\001F\000\000\001]\001^\000\000\002f\001x\001}\002g\000\000\000\000\000\000\000\000\000\000\000\000\001_\001o\001g\001a\001b\000\193\000\000\001_\001o\000\000\001a\001b\000\000\001#\001]\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\0011\000\000\000\000\000\000\001_\001o\000\000\001a\001b\0011\000\000\000\000\001\t\001p\000\000\001q\001\151\000\000\001\016\001\029\001p\001\t\001q\001\129\000\000\000\000\000\000\001\016\001\029\000\000\000\000\001z\000\000\001]\001^\000\000\000\000\000\000\000\000\001{\000\000\001}\001e\000\000\001x\000\000\000\000\001p\000\000\001q\001~\001x\000\000\001_\001o\001g\001a\001b\000\193\000\000\000\000\000\000\001g\0017\000\000\000\193\000\000\000\000\000\000\000\000\001\030\000\000\0017\000\000\001?\000\000\000\000\000\000\001x\001\030\000\000\001]\001^\001?\000\000\000\000\000\000\001]\001^\001g\000\000\000\000\000\193\000\000\000\000\000\000\001p\001'\001q\001s\001A\001_\001o\000\000\001a\001b\001'\001_\001o\001A\001a\001b\000\000\000\000\001z\000\000\000\000\000\000\000\000\001]\001^\001z\001{\000\000\001}\001e\000\000\001x\000\000\001{\000\000\001}\001e\000\000\000\000\000\000\000\000\000\000\001g\001_\001o\000\193\001a\001b\001p\000\000\001q\001v\001z\000\000\001p\000\000\001q\001y\000\000\000\000\001{\000\000\001}\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001]\001^\000\000\000\000\000\000\001x\000\000\000\000\000\000\000\000\000\000\001x\001p\000\000\001q\001|\001g\000\000\000\000\000\193\001_\001o\001g\001a\001b\000\193\000\000\001z\000\000\000\000\000\000\000\000\001]\001^\000\000\001{\000\000\001}\001e\000\000\000\000\000\000\000\000\001x\000\000\000\000\000\000\000\000\000\000\001]\001^\000\000\001_\001o\001g\001a\001b\000\193\000\000\000\000\000\000\000\000\000\000\001p\000\000\001q\001\134\000\000\000\000\001_\001o\000\000\001a\001b\000\000\001z\000\000\000\000\000\000\001]\001^\001z\000\000\001{\000\000\001}\001e\000\000\002\214\001{\000\000\001}\001e\000\000\001x\001p\002\217\001q\001\137\001_\002\185\000\000\001a\001b\000\000\001g\000\000\000\000\000\193\000\000\000\000\000\000\001p\001z\001q\002G\000\000\000\000\000\000\000\000\000\000\001{\000\000\001}\001e\000\000\001x\000\000\001]\001^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001g\000\000\000\000\000\193\000\000\000\000\001x\000\000\000\000\000\000\000\000\001_\001o\000\000\001a\001b\000\000\001g\000\000\000\000\000\193\000\000\000\000\000\000\000\000\001]\001^\001z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001{\001f\001}\001e\000\000\000\000\000\000\001]\001^\000\000\001_\001o\001g\001a\001b\000\193\000\000\000\000\000\000\001p\000\000\001q\002\228\000\000\001z\000\000\000\000\001_\001o\000\000\001a\001b\001{\000\000\001}\001e\000\000\000\000\000\000\001]\001^\001z\000\000\000\000\000\000\000\000\002\186\000\000\000\000\001{\001x\001}\001e\001p\000\000\001q\002\231\000\000\000\000\001_\001o\001g\001a\001b\000\193\000\000\002\r\002\014\001^\000\000\001p\001z\001q\002\234\000\000\000\000\000\000\000\000\000\000\001\150\000\000\001}\001e\000\000\001x\000\000\001]\001^\000\000\002L\001\024\000\000\000\000\001\025\000\000\001g\001B\000\000\000\193\000\000\000\000\001x\001p\000\000\001q\002\242\001_\001o\000\000\001a\001b\000\000\001g\000\000\000\000\000\193\001D\001\027\000\000\000\000\001z\000\000\004\206\000\000\000\000\000\000\000\000\000\000\001{\001\024\001}\001e\001\025\001x\000\000\001B\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001g\000\000\000\000\000\193\000\000\001p\000\000\001q\004A\000\000\001z\001D\001\027\000\000\000\000\000\000\001#\002\016\001{\000\000\001}\001e\000\000\000\000\000\000\000\000\000\000\001z\002\017\000\000\002d\000\193\000\000\0011\000\000\001{\001x\001}\001e\000\000\000\000\000\000\001]\001^\000\000\001\t\000\000\001g\000\000\000\000\000\193\001\016\001\029\000\000\001\024\001#\000\000\001\025\000\000\001z\001+\000\000\001_\002\185\000\000\001a\001b\001{\000\000\001}\001e\000\000\0011\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0010\001\027\000\000\000\000\001\t\000\000\000\000\002e\001]\001^\001\016\001\029\000\000\000\000\000\000\002f\0017\001}\002g\000\000\000\000\000\000\000\000\001\030\000\000\000\000\001z\005\004\001_\002\185\000\000\001a\001b\000\000\001{\000\000\001}\001e\000\000\000\000\000\000\000\000\000\000\000\000\001#\000\000\000\000\000\000\001]\001^\001'\000\000\000\000\001A\000\000\0017\001f\000\000\000\000\000\000\000\000\0011\001\030\001]\001^\000\000\001?\001g\001_\002\185\000\193\001a\001b\001\t\000\000\000\000\001]\001^\000\000\001\016\001\029\000\000\000\000\001_\002\185\000\000\001a\001b\000\000\001'\000\000\000\000\001A\005\150\000\000\000\000\001_\002\185\000\000\001a\001b\003k\001f\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001g\000\000\000\000\000\193\000\000\000\000\000\000\003m\000\000\000\000\000\000\0017\000\000\001z\000\000\000\000\000\000\000\000\001\030\000\000\000\000\001\150\001?\001}\001e\000\000\000\000\000\000\000\000\001f\000\000\000\000\000\000\000\000\003k\000\000\000\000\000\000\000\000\000\000\001g\000\000\000\000\000\193\001f\001'\000\000\000\000\001A\000\000\000\000\000\000\000\000\003l\000\000\001g\000\000\001f\000\193\001z\001]\001^\000\000\000\000\000\000\000\000\000\000\001\150\001g\001}\001e\000\193\000\000\000\000\003k\000\000\000\000\005\174\000\000\000\000\001_\002\185\000\000\001a\001b\000\000\000\000\000\000\000\000\006\001\000\000\000\000\000\000\003p\000\000\000\000\000\000\001]\001^\001z\000\000\000\000\002\186\000\000\000\000\000\000\000\000\001\150\000\000\001}\001e\000\000\000\000\000\000\001z\000\000\000\000\001_\002\185\000\000\001a\001b\001\150\000\000\001}\001e\000\000\001z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\150\006\003\001}\001e\001]\001^\000\000\000\000\000\000\000\000\000\000\001]\001^\000\000\000\000\000\000\001]\001^\000\000\001f\000\000\000\000\000\000\000\000\001_\002\185\000\000\001a\001b\000\000\001g\001_\002\185\000\193\001a\001b\001_\002\185\000\000\001a\001b\000\000\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^\001f\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\186\000\000\005\028\001g\000\000\000\000\000\193\000\000\000\000\000\000\001_\002\185\000\000\001a\001b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001z\000\000\000\000\000\000\000\000\005\029\006\174\005\030\001\150\001f\001}\001e\005\201\000\000\000\000\001\024\001f\000\000\001\025\000\000\001g\001f\000\000\000\193\000\000\000\000\000\000\001g\000\000\000\000\000\193\000\000\001g\000\000\000\000\000\193\005\031\001z\000\000\000\000\000\000\000\000\001\027\000\000\000\000\001\150\000\000\001}\001e\000\000\000\000\000\000\004\191\000\000\005\201\000\000\000\000\000\000\005\214\001f\000\000\006\001\000\000\000\000\000\000\000\000\006\001\005\147\001\024\005 \001g\001\025\000\000\000\193\000\000\000\000\000\000\000\000\005!\001z\005\"\000\000\000\000\000\000\000\000\001#\001z\001\150\000\000\001}\001e\001z\000\000\000\000\001\150\001\027\001}\001e\000\000\001\150\005\213\001}\001e\005^\003o\003\230\000\000\001\024\006\002\001\024\001\025\000\000\001\025\006\n\001\t\000\000\000\000\000\000\000\000\006v\001\016\001\029\000\000\000\000\000\000\000\000\005$\000\000\000\000\001z\000\000\005&\0050\006\014\001\027\000\000\001\027\001\150\001#\001}\001e\005Z\000\000\000\000\004\191\000\000\004\191\000\000\007\r\000\000\000\000\007\014\000\000\000\000\006\017\000\000\000\000\005[\000\000\005\161\000\000\005\171\000\000\006\018\000\000\0017\000\000\001\t\000\000\000\000\000\000\000\000\001\030\001\016\001\029\000\000\004\196\001#\000\000\001#\001]\001^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\019\000\000\002\r\002\014\001^\000\000\000\000\001'\001_\002\170\001A\001a\001b\000\000\001\t\000\000\001\t\000\000\000\000\000\000\001\016\001\029\001\016\001\029\001\024\003M\0017\001\025\000\000\000\000\000\000\000\000\000\000\001\030\006\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\021\001\024\000\000\000\000\001\025\000\000\000\000\000\000\000\000\001\027\001\024\000\000\000\000\001\025\000\000\000\000\000\000\000\000\001'\002\207\007\024\003\237\000\000\0017\000\000\0017\000\000\000\000\001\027\000\000\001\030\000\000\001\030\000\000\004\196\000\000\004\196\001\027\000\000\006\023\001f\000\000\000\000\000\000\000\000\000\000\005\028\003\230\006\024\000\000\000\000\001g\001#\006\026\000\193\002\016\000\000\001'\000\000\001'\001A\003\233\001A\006\028\000\000\000\000\002\017\000\000\002d\000\193\000\000\001#\001\024\000\000\005\029\001\025\005\030\000\000\000\000\006\029\001#\001\t\000\000\000\000\000\000\000\000\000\000\001\016\001\029\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\027\001\t\003O\000\000\000\000\005\196\005\031\001\016\001\029\000\000\001\t\001z\000\000\000\000\000\000\001\024\001\016\001\029\001\025\001\150\000\000\001}\001e\000\000\000\000\000\000\002e\001\024\000\000\000\000\001\025\000\000\000\000\0017\002f\000\000\001}\002g\000\000\005 \001\030\000\000\001\027\001#\002\178\000\000\000\000\000\000\005!\000\000\005\"\000\000\0017\000\000\001\027\000\000\000\000\000\000\000\000\001\030\000\000\0017\000\000\004\224\000\000\000\000\004\227\001'\001\030\006\014\001A\000\000\001\t\005#\000\000\000\000\000\000\000\000\001\016\001\029\000\000\001\024\000\000\000\000\001\025\001#\001'\007\004\000\000\001A\006\017\001\024\000\000\006\218\001\025\001'\005$\001#\003\237\006\018\000\000\005&\0050\000\000\000\000\000\000\000\000\000\000\001\027\000\000\000\000\005Z\000\000\000\000\001\t\000\000\000\000\000\000\001\027\000\000\001\016\001\029\001\024\0017\000\000\001\025\001\t\005[\006\019\000\000\001\030\000\000\001\016\001\029\004\211\000\000\000\000\000\000\000\000\000\000\001\024\000\000\000\000\001\025\000\000\000\000\000\000\000\000\000\000\001\027\000\000\001#\000\000\000\000\000\000\001\024\000\000\001'\001\025\000\000\001A\001#\006\020\000\000\000\000\0017\000\000\001\027\000\000\000\000\006\021\000\000\001\030\000\000\000\000\0015\004\224\0017\000\000\005\242\001\t\000\000\001\027\000\000\001\030\000\000\001\016\001\029\006\219\000\000\001\t\007\005\001#\000\000\000\000\000\000\001\016\001\029\000\000\001'\000\000\000\000\001A\000\000\000\000\000\000\000\000\000\000\000\000\006\023\001#\001'\000\000\000\000\001A\000\000\001\024\000\000\006\024\001\025\000\000\001\t\000\000\006\026\000\000\001#\001\024\001\016\001\029\001\025\000\000\0017\000\000\006\028\000\000\000\000\000\000\000\000\001\030\001\t\000\000\0017\006\179\001\027\001\024\001\016\001\029\001\025\001\030\006\029\000\000\000\000\001Q\001\027\001\t\000\000\000\000\000\000\000\000\000\000\001\016\001\029\002\r\002\014\001^\001'\000\000\000\000\001A\000\000\000\000\001\027\0017\000\000\000\000\001'\000\000\000\000\001A\001\030\002\r\002\014\001^\001\167\000\000\002N\001#\002\r\002\014\001^\0017\000\000\000\000\000\000\000\000\000\000\001#\001\030\000\000\000\000\000\000\000\000\000\000\002X\000\000\0017\001'\000\000\000\000\001A\002c\000\000\001\030\000\000\001#\001\t\001\205\002\r\002\014\001^\000\000\001\016\001\029\000\000\001'\001\t\000\000\001=\000\000\000\000\000\000\001\016\001\029\000\000\001\024\000\000\000\000\001\025\000\000\001'\002r\000\000\001A\001\t\000\000\000\000\000\000\000\000\000\000\001\016\001\029\000\000\001\024\000\000\000\000\001\025\000\000\002\016\000\000\000\000\000\000\001\027\000\000\000\000\000\000\000\000\0017\000\000\002\017\000\000\002d\000\193\000\000\001\030\000\000\002\016\0017\001\207\000\000\001\027\000\000\000\000\002\016\001\030\000\000\000\000\002\017\002$\002d\000\193\000\000\000\000\000\000\002\017\0017\002d\000\193\000\000\000\000\000\000\001'\001\030\000\000\001A\001#\0027\000\000\000\000\000\000\000\000\001'\000\000\002\016\001A\000\000\000\000\000\000\001\024\000\000\000\000\001\025\000\000\001#\002\017\000\000\002d\000\193\002e\001'\000\000\000\000\001A\000\000\001\t\000\000\002f\000\000\001}\002g\001\016\001\029\000\000\000\000\000\000\001\027\002e\000\000\000\000\000\000\000\000\000\000\001\t\002e\002f\000\000\001}\002g\001\016\001\029\000\000\002f\000\000\001}\002g\000\000\000\000\000\000\001\024\000\000\000\000\001\025\000\000\000\000\000\000\000\000\000\000\001\024\000\000\000\000\001\025\000\000\000\000\002e\000\000\0017\001\024\000\000\001#\001\025\000\000\002f\001\030\001}\002g\001\027\002\175\000\000\000\000\000\000\000\000\000\000\000\000\0017\001\027\000\000\002\r\002\014\001^\000\000\001\030\000\000\000\000\001\027\002\180\000\000\000\000\001\t\000\000\001'\000\000\000\000\001A\001\016\001\029\000\000\000\000\001\024\000\000\003\020\001\025\000\000\000\000\000\000\000\000\000\000\001\024\001'\001#\001\025\001A\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\027\000\000\001#\000\000\000\000\000\000\000\000\000\000\000\000\001\027\000\000\000\000\000\000\001\t\0017\001\024\000\000\000\000\001\025\001\016\001\029\001\030\001\t\000\000\000\000\002\197\000\000\000\000\001\016\001\029\001\024\001\t\001\024\001\025\000\000\001\025\000\000\001\016\001\029\000\000\000\000\000\000\001\027\001#\000\000\000\000\000\000\002\016\001'\000\000\000\000\001A\001#\000\000\000\000\000\000\000\000\001\027\002\017\001\027\002d\000\193\000\000\000\000\0017\000\000\000\000\000\000\000\000\000\000\000\000\001\030\001\t\0017\000\000\002\204\000\000\000\000\001\016\001\029\001\030\001\t\0017\000\000\002\211\001#\000\000\001\016\001\029\001\030\000\000\001\024\000\000\002\220\001\025\000\000\000\000\000\000\001'\000\000\001#\001A\001#\000\000\000\000\000\000\000\000\001'\000\000\000\000\001A\000\000\000\000\000\000\001\t\000\000\001'\002e\001\027\001A\001\016\001\029\000\000\0017\000\000\002f\000\000\001}\002g\001\t\001\030\001\t\0017\000\000\004P\001\016\001\029\001\016\001\029\001\030\000\000\001\024\000\000\004\168\005\005\000\000\000\000\000\000\000\000\000\000\001\024\000\000\001\024\005\005\000\000\001\025\000\000\001'\000\000\000\000\001A\001#\000\000\000\000\000\000\0017\001'\001\024\001\027\001A\001\025\000\000\001\030\000\000\000\000\000\000\004\180\001\027\000\000\001\027\0017\000\000\0017\001\024\000\000\000\000\001\025\001\030\000\000\001\030\001\t\004\193\000\000\004\210\001\027\000\000\001\016\001\029\001\024\001'\001\024\001\025\001A\005\005\000\000\000\000\000\000\000\000\000\000\000\000\001\027\005\007\000\000\000\000\001'\000\000\001'\001A\000\000\001A\005\007\000\000\001#\000\000\000\000\001\027\000\000\001\027\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001#\000\000\000\000\001\t\0017\000\000\000\000\000\000\000\000\001\016\005\n\001\030\001\t\000\000\001\t\004\226\001#\000\000\001\016\005\n\001\016\001\029\001\024\000\000\000\000\005\005\000\000\000\000\000\000\001\t\000\000\001#\000\000\005\007\000\000\001\016\001\029\000\000\001'\000\000\000\000\001A\000\000\000\000\000\000\001\t\000\000\000\000\000\000\001\027\000\000\001\016\001\029\000\000\001\024\000\000\000\000\001\025\000\000\000\000\001\t\005\011\001\t\000\000\000\000\0017\001\016\001\029\001\016\005\n\005\011\001\024\001\030\004\213\001\025\005\012\005~\005\r\000\000\000\000\0017\001\027\004\213\000\000\005\024\000\000\005\r\001\030\001'\000\000\000\000\005\144\005\007\000\000\000\000\000\000\0017\001'\001\027\001'\000\000\000\000\001A\001\030\000\000\000\000\000\000\005\168\000\000\000\000\000\000\0017\000\000\001\024\001'\000\000\001\025\001A\001\030\000\000\005\011\001\t\0066\000\000\001#\000\000\000\000\001\016\005\n\000\000\001'\000\000\004\213\001A\005\228\000\000\005\r\000\000\000\000\000\000\001\027\001#\000\000\000\000\000\000\001'\001\024\001'\001A\001\025\000\000\000\000\000\000\001\t\001\024\000\000\000\000\001\025\000\000\001\016\001\029\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\t\000\000\000\000\001\027\000\000\000\000\001\016\001\029\000\000\005\011\000\000\001\027\000\000\001#\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\213\000\000\005\254\000\000\005\r\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0017\000\000\001'\000\000\000\000\000\000\000\000\001\030\001\t\000\000\000\000\006\139\001#\000\000\001\016\001\029\000\000\0017\000\000\000\000\001#\000\000\000\000\000\000\001\030\000\000\000\000\000\000\006\143\000\000\000\000\000\000\000\000\000\000\001'\000\000\000\000\001A\000\000\000\000\000\000\001\t\000\000\000\000\000\000\000\000\000\000\001\016\001\029\001\t\000\000\001'\000\000\000\000\001A\001\016\001\029\000\000\000\000\0017\000\000\000\000\000\000\000\000\000\000\000\000\001\030\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0017\001'\000\000\000\000\001\200\000\000\000\000\001\030\0017\000\000\000\000\000\000\000\000\000\000\000\000\001\030\000\000\000\000\000\000\000\000\000\000\000\000\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\202\000\000\000\000\000\000\000\000\001'\000\000\000\000\003\232"))
+ ((16, "\000%\000\193\000G\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\012\000\000\000\000\000\129\001\152\000\030\0003\000#\000\004\000\190\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\000\000\000\000\000\000\000\000\000\000\000t\000\000\000\000\000\000\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\000\000\000=2\000\000\000\000\000\000\000\254\000\000\000\000\000\000\000\000\000\000\000\000\000\000'\238\001T\001>\000\223\000\000\001B9\220\001\236\001\218\000:\000\000\000\000\000\000\001x\000\000\000\000\000\182\000\000\000\000\000\000\000\000\003\156\000\000\002\150\000\000\000\000\000\000\000\000\000\000\001\022\000\000\000\218\003\202\bf\000\000\000\000\011\018'\238\000\000\000\000\001\254\000\000\000\027\000\000:~\002\184\000\000\001\156\001r\000\000\000\000\002\172\002\142\002\208\003b\001\226\003\202\004\142\000f\001\194\0022\003\216\002\152\011b\000\000\005(\003\244\003\188\002h\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004r\000\000\t>\005(\011\194\000\000\000\000\004.\005d\004\0301\236\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\148\000\000\004\168\005l\005@\000\000\000\000\000\000\000\000\000\173\000\000\000\000\005\144\000\167\006\018\006(\007\214\000\000\0050\005H\006*\000Q\004\228\006L \232\000\000\000\000\005X\006\254\011\204\000\000!\b\001\244!\026\"V\000\000\003B\000\000\000\000\000\000\000\000\006\018=F\006\020\000\000\001\012\0064\000\000\004P6\150\000\131\000\000\001\172\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002:\005\190\000\000\000\000\000\000\000\192\000\000\tD\000\000\000\000\002\164\000o\000\000\000\000\003\248\000\000\006n\000\000\002\164\t\148\002\164\000\000\000\000\000\000\000\000\000\0007 \000\000\007\"\006@\000\000=\168\007N\030`\000\000\000\000\000\000\0062\000\000\000\000\000\000\000\000\006F\000\000\000\000\000\000\000\000\000\0002L\000\000\000\000\000\000\000\000\000\000\000\000\001\158\007N\000\000\000\000\000\000\006F\007\1342\146\006\224\007p\015\214\000\000\003\014\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000(\000\000\000\000\000\000\000\000\b\0122\160\000\000\000\000\007\030\b\0042\214\000\000\000\000\000\00038\007\0143\152\000\000\007\014\000\0003\164\007\014\000\0003\228\007\014\000\000\007\014\000\000\000\000\007\014\000\000\000\0004J\000\000\007\0144\138\000\000\007\014\002|\000\000\000\000\"V\000\000\000\000\000\000\000\000\007\014\"z\000\000\000\000\000\000\007\014\000\000\006F\007\246\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\016\000\000\007\136\000\000=\132\006F\000\000\000\000\000\000\000\000\b\b\b\184\012$\b\026\b\030\b@\b\028\005\014\b`\0001\t\006\000\000\000\000\000\029\005\136\b\160\001\172\b\200\bL\000\000\000\145\004\138\005\180\007\136\n\"\000\000\000\000C\158\000\000C\224\t\212\000\000=\198\006F>@\006F\000\000\003\"\000\000\003x\000\000\000\000\003\220\000\000\000\000\000\000\nt\000\000\n\030\000\145\000\000\000\000\t>\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\145\000\000\000\000\000\145\000\000\b\200\007\014\000\000\002\182\004\228\000\000\002\182\000\000\000\000\n\206\000\145\000\000\000\000\000\000\000\000\000\000\000\000\002\182\012\132\rL\n4\t\218\"\152\000n\000\000\t\130\b\182\r\158\t\234\b\228\025X1N\000\000\000\000\000\000\000\000\000\000\0032\t\188\000\000\000\000\000\000\t\250\b\244\007V\002\182\011\240\000\000\000\145\000\000\000\000\000\000\001\244\000\000>T\006F\r\166\n\018\t\030\r\254\n \t0\014\180\"\186\007\014\015\024\n\"\t89\190\n\244\000\000#\002\007\014>x\006F\n\238\000\000\000\000\000\000\000\000\007\148\011&\011L\000\000\000\000\b\176\015 \n\208\t>4\172\007\014\015t\n\222\tF6(\000\000>\172\000\000\000\000\015|\"\244\018\\\000\000\000\000\000\000\000\000>\208\000\000\000\000\000\000\007\172\016B\000\000\000\000\000\000\000\000#^>\222\000\000\000\000\000\000\000\000\000\000\n\170\016\150\000\000\n\180$\"\n\180$,\n\180\000\000?\026\000\000$\128\n\180\016\234\004\152\016\244\000\000\000\000$\136\n\180%\022\n\180%\030\n\180%\250\n\180&\002\n\180&\026\n\180&\152\n\180&\246\n\180&\254\n\180'\140\n\180'\148\n\180'\232\n\180(v\n\180(\128\n\180)\014\n\180)^\n\180)h\n\180)\246\n\180*F\n\180*\212\n\180\t\170*\2484\232\007\148\011x\000\000+8;l\000\000\017N\000\000?,\000\000\006F;\166\000\000\006F?P\006F\000\000\017\184\000\000\000\000\000\000+\\\000\000\000\000\000\000\000\000\000\000\007\014\000\000\000\000?\210\000\000\006F\000\000\000\000;\166\011\136\000\000@6\006F\018\018\000\000\000\000\011\"\000\000@H\006F\018\160\000\000\000\000\018\196\000\000\000\000\000\000@Z\006F\019\028\000\000\n\252\019\132\000\0005J\000\000\007\0145\142\000\000\007\0145\176\000\000\007\014\003d\000\000\000\000\000\000\000\000\000\0005\240\007\014\004\222\005\022\000\000\000\000\000\000\n\180\019\222\000\000\000\000\000\000+\150\n\180\000\000\000\000\000\000\000\000\0206\000\000\000\000\000\000\n\180\020D\000\000\020\158\000\000\000\000\000\000\021\004\000\000\000\000\000\000\000\000@\146\000\000\000\000\021^\000\000\000\000\000\000,H\n\180\021l\000\000\000\000\000\000,\138\n\180\021\196\000\000\000\000,\176\n\180\n\180\000\000\007\228\022\030\000\000\000\000-\b\n\180\022l\000\000\000\000-(\n\180-v\n\180\000\000.\004\n\180\000\000\000\000\022\250\000\000\000\000.\152\n\180\023,\000\000\000\000.\200\n\180\023\\\000\000\000\000.\232\n\180\000\000/\000\n\180\000\000;\138\000\000\000\000\n\180\000\000\000\000\023\142\000\000\000\000\023\192\000\000\000\000\011D\000\000\000\000\024\028\000\000\024$\000\000\000\000\000\000\007\148\011\226\000\0007\022\n<\002\164\025\004\000\0007r\000\000\000\000\000\0007\194\000\000\000\000\025$\000\000\025\146\000\000\000\000\000\000\000\000/\n\000\000\000\000\000\000/f\n\1800r\n\180\000\000\n\252\025\156\000\000\000\000\025\236\000\0000T\000\000\000\0001N\000\000\000\000\000\000\026\134\000\000\000\000\000\000\000\000\026\144\000\000\000\000\000\000\000\000\012\152\000\000\000\000\000\000\003\154\000\000\000<\000\000\000;\000\000\0128\000\000\004\144\000\000\000\000\000\000\000\000\000\000\000\000\0032\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\180\000\000\012\164\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\184\007\232\002\182\027T\000\000\011\166\t\224\012*\001\144\t\136\002\182\r@\000\145\t\176\002\182\000\000\027x\000\000\004\142\000\000\011\194\t\238\004X\000\000\000\000\000\000\000\000\000\000\011\218\001.\000\146\000\000\000\000\000\000;\222\000\000C\240\000\000\t\246\000\000\n\016\000\000\000\000\000\000\000\000\002\158\000\000\000\000\000\000\011*\002\164\000\000\002\164\001\178\000\000\rv\002\164\002\164\n\024\000\000\027\186\000\000\000\000\n8\012\172\000\0000\180\005$\000\000\000\000\000\000\000\000\000\000\000\000\n\180\000\000\028\180\000\000\n\180\000\000\000\000\014\242\000\000\000\145\000\000\016H\000\000\000\145\000\000\017\012\000\145\000\000\003Z\000\000\n<\n\022\005`\000\000\011\226\011\234\nV\012\024\012\164\017T\000\145\006\012\000\000\nZ\012\134\012\188\005\024\006\184\012\150\n\130\r\014\006\146\b\132\012\228\000\000\000\000\007\188\b\148\000\000\004\168\002\2426N\007\014\028\028\000\000\007X\003\178\012\158\n\154\011^\005\224\000\000\012\168\n\158\006\200\000\000@\172\006F\rZ\r\132\000\000\t:\000\000\012\244\n\166\006>\r2\003V\000\000\000\000\000\000\000\000\n\216\tZ\000\000\n\222\tl\000\000\bb\0164\rF\rP\n\228\006\216\t\172\000\000\n\230\007\138\n\018\000\000\rR\n\238\r\220\000\000\t\028\000\000\n\132\000\000\r\252\000\000\018\024\000\145\r\216\011\002\014\022\000\000\018\202\0056\r\236\000\000\000\000\003j\006\160\011$\000\000\019\228\000\145\011F\000\000\004\022\000\000\r\210\011\016\0212\006\154\000\000\r\222\011>\007\176\r2\r\230\r\240\011L\015F\000\000\014\000\001\200\000\000\000\000\000\000\000\000\000\171\011X\r\226@\190\006F\000\000\002\200\011\142\014\148\000\000\000\000\000\000\000\000\000\000\000\000A\000\006\164\000\000\011\182\014\246\000\000\000\000\000\000\000\000\000\000\000\000\006\174\000\000A\030\006F\011\226\000\000\006F\011\218\000\184\000\000\011\230\011\232\007\024\000\000\001\004\004L\000\000\002\190\000\000A\"\006F\006F\000\000\000\000\007\b\000\000\b\252\000\000\001\186\007\b\007\b\000\000\011\236;\204\006FA\152\006F\012\b\000\000\000\000\000\000\000\000\012\014\000\000\000\000\007N\000\000\007l\014`\011\240\015p\014*\000\000\000\000\001\196\b|\014h\000\000\000\000\011\250\015\128\014@\000\000\000\000\029\018\000\000\012\222\000\000!(6H\006F\000\000,N\018\132\000\000A\252\000\000\000\000\000\000\007\b\000\000\000\000\012:\014|\012\000\015\144\014J\000\000\000\000B\014\012\144\014\140\000\000\000\000\000\000<:\000\000\000\000\000\000\000\000\000\000\000\000\012\146\000\000\014\152\012\020\006\162\000\000\015\134\015>\012\180\014\166\000\000\000\000\014\170\012>\b*\000\000\000\000\tl6\150\005|\000\000\000\000\000\000\bL\014p\012p\000\000\014z\bL\000\000\015V\012\188\014\196\000\000\000\000\000\000\006F\003v\004(\005\180\000\000\000\000\000\000\000\000\014\138\012t\000\000\006\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006F\014z\012\128\015\208\014\138\000\0007\224\000\237\012\146\014^\003\156\000\019\012\150\015\016\000\000\015\200\028\130\000\000\000\000\029J\000\000\012\208\000\000\nL\000\000\000\000\000\000\000\000\000\000\000\000B\018\006F\000\000\015\204\029l\000\000\000\000\030\002\000\000\000\245\012\156\015r\000\000\000\0007\250:\020\015(\000\000B0\006F\0302\000\000\000\000\030T\000\000\000\000\r0\000\000\000\\\000\000\000\000\000\000\000\000\000\000\000\000:\204\000\000\000\0008\188:\208\015*\000\000BP\006F\030\234\000\000\000\000\031\028\000\000\000\000\012\184\031<\r<\000\000\012\190\012\198\002\016\002\208\012\200\t&\012\214\015|0\214\r\\\000\000\r\016\r2\tf\000\000\004*<Z\000\000\004.\000\000\rH9\0069Z\005\236\014j\006l\000\000\020\144;\138\000\000\0001\000\000\000\000\0001\000\000\000\000\0001\n\002\000\000\011\000\0001\015\1380\238\rh\000\000\0001\000\000\000\000Br\000\000\000\000\000\000\0001\000\000\000\000\r\166\000\000\r\030\005\190\r\200\000\000\rJ<\174\r\248\000\000\000\000\000\000\000\000\014\000\000\000\000\000\006\018\000\000\0001B\232\000\000\014\216\00019h\000\000\014\b\014\242\rN\016\n\014\200\000\0009r\014\014\015\002\000\000\000\000\000\000\019\012\b\026\000\000\000\000\000\000\000\000\000\000\000\000\n\170\014\020\000\000\015\018\000\000\000\000\000\000\000\000\014\026\027F\000\000\000\000\000\000\000\000\n\170\000\000\000\000\014.\031\170\000\000\000\000\000\000\000\000\000\000\002\182\000\145\000\000\000\000\007\014\000\000Bn\006F\000\000\007\212\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014\202\rP\011\246\002\182\000\000\022\n\000\000\000\145\000\000\016\004\000\000\000\000\000\000\000\000\000\000 (\000\000\000\000\000\000\000\000\000\000\000\000\015\170\002\022\t\210\014p\003\144\r\148\000\000\000\226\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014\138\005^\r\176\000\000\007$\016\n\015\188\014J\000\000\000\000\015\180\002\202\b\150\000\000\000\000\000\000\r\180\000\000\r\206\000\240\000\000\000\000\002\164\b\128\000\000\000\000\000\000\000\000\000\000.\226\000\000\000\000\007h\007\238\000\000\000\000C(\006F\006F\000\000CJ\006F\bP\000\000\000\000\000\000\006F\000\000\000\000\t\246\015\196\014\\\000\000\000\000\015\184\000\170\001\200\000\000\000\000\000\000\000\000\b\002\016\n\nl\015\200\014h\000\000\000\000\015\190\004\188\003\142\000\000\000\000\000\000\000\000\000\145\000\000\b\222\000\000\000\000\000\000 \004\000\000 \182\000\000\000\000\000\000\000\000\000\000-\226\000\000\000\000\000\000\005\022\000\190\000\000\000\000\000\000\000\000\000\000\002V\000\190\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0050\000\000\000\000\000\000<\198\000\000\006F\000\000\n*\000\000\000\000\000\000\001\030\000\000\000\000\000\000\001\214\000\000\000\000\000\000\0001\000\000\000\000\000\0000\250\007\014\000\000\000\000\000\014\000\000\000\000\000\000\000\000\0032\004\128\015\b\004D\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000=.\000\000\014v\000\000\000\000\000\000\000\000\005H\006\246\r@+\182\000\000\000\000\014\150/~\000\000\000\000\000\000\014\162;\020\000\000\000\000\000\000\000\000"), (16, "\006\021\003\169\002\020\002\021\001e\0007\002\251\001\198\000\196\006\184\005{\000\200\000\201\005\158\001\246\001\031\001\230\002X\006\022\006\195\001\234\006\024\001\023\000q\001e\002Y\005\160\006\249\002\021\001e\006\025\006&\001\198\006\021\0067\002\020\002\021\001e\002g\005\210\0066\001\230\001\016\002\003\001\244\001\234\000\200\001\023\001\023\001\026\002X\006\022\006%\000\147\006\024\006\170\001\215\001\246\002Y\006\026\001\235\005\165\001\016\006\025\006&\001k\006\241\005\212\001\023\001\026\003\170\002g\001\016\004\132\001\236\002\020\002\021\001e\001\023\001\026\003\167\005\241\005\213\004&\006\190\001\235\002\003\005\215\000\203\000\200\000;\006\003\006\026\006\027\006\242\006\251\006\188\002i\003\165\001\236\004\219\006\028\002\004\001\230\001\198\003\174\001\242\001\234\002\024\001\023\002k\000\200\004\220\001\230\001\016\000\147\004\244\001\234\000\152\001\023\001\023\001$\005\169\006\135\001\031\006+\006\027\001 \003\187\002\251\002i\000@\001\027\006\252\006\028\002k\000\200\006\162\001\229\005}\006,\002\024\001(\002k\000\200\002\004\000\203\001\235\001\031\006\031\000\153\001\"\006\197\001\238\006!\006\165\000\196\001\235\006+\000\200\001\002\000?\001\031\000\147\006#\001 \000\156\002l\0012\002r\002\023\001\236\001%\006,\0007\002x\000:\001\132\002n\001\031\006$\003\178\006\031\002k\000\200\001\002\005\217\006!\0013\001\"\003\234\002\251\003\168\000\203\001*\001Q\006\\\006#\002z\006\131\002l\000\203\002r\006\021\000m\002\020\002\021\001e\002x\003\250\001\132\002n\000\147\006$\000\157\001\215\001l\003\168\000\\\001\016\002X\006\022\006%\001\016\006\024\001\023\001\026\000`\002Y\001\023\001$\002z\001*\006\025\006&\006\233\001\016\003\245\003\247\003\249\002l\002g\001\023\001$\0007\001\031\0007\001\016\002m\0018\001\132\002n\000\147\001\023\001$\000\152\006\130\001\016\006f\006\168\006\169\001\016\006\026\001\023\001\026\0007\006{\001\023\001$\006]\006\234\001\169\001e\001T\0011\003\250\001\023\004\219\001\016\005W\004\b\001%\001\196\001\031\001\023\001$\006\137\004\167\006g\004\220\000d\001f\002)\004\227\001h\001i\006\027\006h\000y\006\021\002i\002\020\002\021\001e\006\028\001%\002\251\000\129\001.\000\132\001\"\002\024\001>\002k\000\200\004\219\002X\006\022\006%\001%\006\024\006\213\001W\001F\002Y\003\217\006\237\004\220\006+\006\025\006&\004\221\006\131\003\137\002\246\002\247\001%\002g\006e\001\147\001e\001\019\003\253\006,\001\016\0009\001.\001\023\001\016\001H\001\023\001$\006\031\001\016\001\023\001\026\000\128\006!\006\026\001\023\001\026\006\238\006Z\003\254\000\200\001\127\001)\006#\001\016\000\203\002l\000\203\002r\006\166\001\023\001$\001n\003\220\002x\000\200\001\132\002n\001\016\006$\000\147\000\135\006q\001\215\001\023\001$\000\196\001\238\006\027\000\200\000\201\006\021\002i\002\020\002\021\001e\006\028\002z\001%\006\167\003\140\003\145\004\219\002\024\004\000\002k\000\200\004\219\002X\006\022\006%\000=\006\024\000\174\004\220\001`\002Y\005\210\004\226\004\220\006+\006\025\006&\004\252\006y\004\003\003\181\001e\000\134\002g\000\196\001\129\000\186\000\200\000\201\006,\001%\006i\006j\001\130\002\001\001\132\001l\000\203\006\031\005\212\006k\006l\003\234\006!\006\026\002\244\001e\000\147\006-\000\181\001\215\006m\004\b\006#\005\213\001\016\002l\001.\002r\005\215\006\214\001\023\001$\005\238\002x\000\179\001\132\002n\001\016\006$\000\189\002\020\002\021\001e\001\023\001\026\000\196\000\151\006\027\000\200\000\201\006\021\002i\002\020\002\021\001e\006\028\002z\004\236\003\248\003\247\003\249\000\150\002\024\003\165\002k\000\200\002\251\002X\006\022\006%\003\174\006\024\000\202\000\183\005F\002Y\005\210\001\016\000\172\006+\006\025\006&\004\239\001\023\001$\002\001\001\217\000\178\002g\000\200\006i\006j\002\251\003\175\006,\001\031\000\203\004\241\001+\006k\006l\000\203\000\196\006\031\005\212\000\200\001\002\004\215\006!\006\026\006m\004\b\004c\006)\001\003\000\200\002\002\004\242\006#\005\213\004\147\002l\001\"\002r\005\215\007\005\002\021\001e\005\231\002x\001\219\001\132\002n\004'\006$\002\023\001\023\001\031\001\006\001\031\001 \004c\001 \006\027\000\200\0012\003\178\002i\002k\000\200\001\002\006\028\002z\006\021\001\223\002\020\002\021\001e\002\024\006\180\002k\000\200\005\251\005F\001\"\0013\001\"\007\b\007\t\004\213\002X\007\011\001O\004\149\006\024\006+\005M\005N\002Y\004f\001\222\001\132\003\168\006\025\007\r\000\194\001\023\0007\005\254\006\167\006,\002g\005^\003\173\001\016\0007\005W\004\b\002\002\006\031\001\023\001$\001\224\006\000\006!\002l\004\150\001*\006c\001*\001\132\000\184\006\026\002m\006#\001\132\002n\002l\000\196\002r\000\196\000\200\000\201\000\200\000\201\002x\0018\001\132\002n\006\001\006$\007\006\006\206\002k\000\200\006\179\001\016\000\188\001\016\002\020\002\021\001e\001\023\001$\001\023\001$\006\027\000\203\002z\005\210\002i\000\193\001%\006\021\006\028\002\020\002\021\001e\007\028\004\149\002\251\002\024\006G\002k\000\200\005M\005N\003\221\007\020\000\196\002X\007\021\000\200\001\002\006\024\007\016\000\204\005\212\002Y\001.\000\211\005V\001\246\006\025\007\029\005W\004\b\001>\002\251\001>\006?\002g\005\213\006,\001%\002\251\001%\005\215\004\218\005\205\001F\005\222\006\031\001\246\002\251\003\168\006\207\006!\001\250\003\230\004\b\002\003\006\026\000\147\000\200\001\202\001\215\006#\006\221\003\220\002l\001.\002r\001.\001H\002\251\001H\002\253\002x\002\005\001\132\002n\002\003\006$\002\023\000\200\0049\006\208\000\203\006\168\006\169\000\224\006\215\001\023\002\001\002\024\006\027\002k\000\200\004c\002i\002z\000\200\000\228\006\028\002\252\001d\001e\002~\005W\004\b\002\024\004\014\002k\000\200\006\021\004F\002\020\002\021\001e\002\004\004\138\004c\004\019\007!\000\200\001f\002\192\003\234\001h\001i\006\216\002X\006\022\0063\001\198\006\024\001\239\003\220\002\251\002Y\002\004\004+\006,\001\230\006\025\006&\000\212\001\234\005\245\001\023\000\225\006\031\002g\002l\006\217\003\234\006!\002\001\004(\001\031\002\251\002m\001 \001\132\002n\006\222\006#\001\132\000\234\002l\000\241\002r\006\218\006\026\005?\003\247\003\249\002x\000\249\001\132\002n\000\147\006$\0050\001\215\001\229\001\"\001\235\006o\001Y\001\132\001\031\000\196\001\n\001 \000\200\000\201\004U\001e\001m\002z\001\236\005S\003\247\003\249\004Q\002\002\006\027\000\203\001\r\001n\002i\000\203\000\200\001\030\006\028\001;\006\021\001\"\002\020\002\021\001e\002\024\005\210\002k\000\200\006\002\0044\004\198\001*\000\203\002\251\007\020\000\236\002X\007\021\002\251\000\196\006\024\006+\000\200\001\002\002Y\004\201\002\193\000\242\002\251\006\025\007\024\001\164\006v\005\212\005\254\005\217\006,\002g\000\196\003\234\001\016\000\200\000\201\001*\000\245\006\031\001\023\001$\005\213\006\000\006!\001\129\002\002\005\215\001B\001\006\004>\005\219\006\026\001\157\006#\001\132\001l\002l\004\143\002r\006\144\000\200\002\251\005\210\0007\002x\001\016\001\132\002n\006\001\006$\000\203\001\023\001$\004\155\001d\001e\004`\004\b\004\188\005[\003\247\003\249\000\203\001\246\001-\006\027\004r\002z\004:\002i\005\212\001%\001\023\006\028\001f\001v\001G\001h\001i\000\203\002\024\003\220\002k\000\200\006\021\005\213\002\020\002\021\001e\001\247\005\215\002\251\002\003\007\027\005\216\000\200\001>\004\210\001.\001\246\000\200\002X\006\022\001%\001\016\006\024\000\250\004\203\004\228\002Y\001\023\001$\006,\001V\006\025\006/\006\176\001w\001\229\001x\002\199\006\031\002g\001G\001E\002!\006!\001\159\002\003\001\\\001.\000\200\000\147\001H\005:\001\215\006#\001\156\001\016\002l\004\243\002r\000m\006\026\001\023\001$\001C\002x\001\127\001\132\002n\002\004\006$\000\196\005#\004v\000\200\001\002\004\245\001n\001t\001\023\000\200\001]\001\031\004\239\001\031\001 \000\203\001 \002z\003\b\001\246\004\222\000\200\001\002\001~\006\027\004C\001\031\004\241\002i\005$\005d\005%\006\028\000\203\002\004\001\163\001\203\001\175\001\"\002\024\001\"\002k\000\200\001d\001e\003\204\003@\004\242\002\003\000\200\001\002\000\200\001\016\006@\003\025\000\203\0062\005F\001\023\001\026\005&\004L\001\016\001f\002\192\001\129\001h\001i\001\023\001$\004\222\006,\000\203\001\130\002\251\001\132\001l\003\220\002\251\005\254\006\031\001*\003Q\001*\001u\006!\002\251\002\251\004\159\004\b\001\198\003\234\001\199\005'\006\000\006#\001\186\006\157\002l\001\230\002r\001\180\005(\001\234\005)\001\023\002x\002\004\001\132\002n\001\016\006$\001\016\002\020\002\021\001e\001\023\001$\001\023\001$\006\001\0007\006\143\002\251\001\031\001\016\004\016\005e\002X\002z\001\188\001\023\001$\004\t\006\133\003\202\002Y\001m\006\152\003\247\003\249\004\253\006Q\001\235\001\031\004?\000\203\001 \001n\002g\005+\000\200\001\185\004D\006z\005-\0057\001\236\000\203\005M\005N\001>\001\195\001>\001\031\005a\005C\004\b\001%\002\251\001%\001\"\005f\002\015\005O\005_\002\020\002\021\001e\005W\004\b\005b\003r\001%\006g\002\251\004\224\001\191\005F\000\200\006\187\002X\000\203\006h\002\251\001.\002\018\001.\001H\002Y\001H\003u\000m\004~\002 \003\147\004\222\001\129\002i\001\023\006\131\001\237\002g\001\031\001*\001\157\001 \001\132\001l\002\024\001\208\002k\000\200\001\016\000\203\002/\002\251\001\246\005I\001\023\001$\002\020\002\021\001e\0022\000\203\004\\\001\210\0028\005\200\001\"\002M\000\200\001\016\005\130\002R\002X\001\246\001\031\001\023\001$\002o\004h\003\212\002Y\001G\002\003\005F\000\203\000\200\006\229\004k\001\226\001\016\001\233\000m\000\203\002g\003\195\001\023\001$\002i\001\031\003\216\003\191\001 \002\003\002\251\002l\000\200\002r\001%\002\024\001*\002k\000\200\002x\000\203\001\132\002n\005M\005N\005\192\004s\001>\002\170\000\203\006\159\001\246\001\"\000\203\001%\003\203\000\203\006\231\005O\005_\000\203\001&\002z\005W\004\b\001\016\002\014\002o\002\004\005F\005\224\001\023\001$\000\200\001%\003\209\001\198\004*\001\228\002i\002\003\001.\003\224\000\200\001H\001\230\003\241\002\251\002\004\001\234\002\024\001\023\002k\000\200\002l\001*\002r\004w\005\134\003\243\001\016\0010\002x\004\005\001\132\002n\001\023\001$\001\031\006\173\000\203\001 \005M\005N\006a\004\b\001>\000\203\002\017\004\n\001\031\004)\002o\001%\001\016\002z\002\031\005O\005_\001\235\001\023\001$\005W\004\b\004/\001\"\0046\000\203\002.\002\004\002\020\002\021\001e\001\236\000\203\0021\0027\002C\000\203\002l\001.\002r\005F\001H\004\127\002X\004<\002x\001%\001\132\002n\000\203\002@\002Y\001\198\000\203\001\254\002\251\004O\006V\004T\005M\005N\001\230\004_\001>\002g\001\234\001*\001\023\002z\000\203\001%\000\203\002\251\003o\005O\005_\002\020\002\021\001e\005W\004\b\002\020\002\021\001e\000\203\000\196\000\203\004g\000\200\000\201\004j\002X\002H\004q\004u\001\016\002X\001.\004z\002Y\001H\001\023\001$\001\246\002Y\001\235\000\203\001\016\004\134\006D\004\021\002G\002g\001\023\001$\004\153\005\210\002g\000\203\001\236\000\203\002L\004\144\002i\000\203\002\020\002\021\001e\002Q\004P\002\254\002w\002\003\002\174\002\024\000\200\002k\000\200\004\158\004\148\002X\002\209\005M\005N\005\212\004\163\001>\002\216\002Y\000\203\002\251\004\173\000\203\001%\004\015\000\203\000\203\006\155\006\156\005\213\000\203\002g\005W\004\b\005\215\001%\002o\002\245\005\226\002\251\000\203\002i\002\251\002\020\002\021\001e\002i\000\203\004\179\001\246\001.\003d\002\024\001H\002k\000\200\003l\002\024\002X\002k\000\200\002\004\003\252\002l\002\251\002r\002Y\001\198\004\190\002$\000\203\002x\003\201\001\132\002n\006K\001\230\000\203\002\003\002g\001\234\000\200\001\023\000\203\002o\003\161\004\205\004\202\003\171\002o\002i\003\193\004\223\004\209\002z\004\230\001\031\004\247\003\208\005\b\003\210\002\024\005\001\002k\000\200\005\026\004\235\002\251\002\251\004\240\000\203\002l\003\223\003\014\004\004\005/\002l\004\012\002r\002x\001\235\001\132\002n\001\"\002x\002\251\001\132\002n\0045\002\251\000\203\005\024\004.\002o\001\236\006\021\0059\002\004\002i\002\251\0040\0043\002z\002\020\002\021\001e\004B\002z\000\203\002\024\007\020\002k\000\200\007\021\000\203\000\203\006\024\000\203\002X\000\203\002l\005E\002r\005Y\000\203\006\025\002Y\000\203\002x\005i\001\132\002n\001\031\0048\005 \005,\003\198\000\203\005o\002g\005s\002o\004A\005\143\002\020\002\021\001e\002\251\002\020\002\021\001e\002z\0054\002\251\006\026\001\016\005K\005\183\000\203\002X\005\243\001\023\001$\002X\005\188\005\227\005|\002Y\002l\002\251\002r\002Y\005\193\003\184\004=\002\251\002x\003\136\001\132\002n\002g\004@\004N\000\203\002g\000\203\000\196\004S\006\027\000\200\000\201\000\203\002\020\002\021\001e\001\198\006\028\003\214\002i\002z\000\203\005\223\000\203\004[\001\230\000\203\002\251\002X\001\234\002\024\001\023\002k\000\200\001%\005\159\002Y\007\023\005\210\005\199\000\203\005\185\003\131\000\203\002\251\004Z\004^\000\203\000\203\002g\005\207\005\248\001\016\006\r\006J\000\203\006\030\005\196\001\023\001$\002i\001.\002o\005\230\002i\006\031\005\212\004i\002\251\001\235\006!\002\024\002\251\002k\000\200\002\024\002\251\002k\000\200\002\251\006#\005\213\002\251\001\236\000\203\002\251\005\215\004t\006d\002l\005\244\003\014\004p\004y\005\242\002\251\006$\002x\004\141\001\132\002n\000\203\006p\002o\006~\001d\001e\002o\002i\002\251\001%\005\246\000\203\000\203\004\129\000\203\000\203\006\128\002\251\002\024\002z\002k\000\200\004\140\002\251\001f\001v\004\135\001h\001i\002l\002\251\002r\004\139\002l\005\250\002r\004\002\002x\005\255\001\132\002n\002x\006\011\001\132\002n\006\018\002\251\003\127\006 \000\203\002o\006'\002\251\002\020\002\021\001e\004\152\002\020\002\021\001e\002z\0060\004\157\000\203\002z\000\203\005\000\001w\002X\001x\0024\004\162\002X\004\165\004\169\006u\002Y\002l\000\203\002r\002Y\004\177\003x\004\184\006\161\002x\003i\001\132\002n\002g\006\175\004\195\004\255\002g\004\248\004\249\004\254\007\014\001\127\002\020\002\021\001e\005\002\002\020\002\021\001e\005\003\005\"\002z\001n\005\027\005\028\000\200\007\025\002X\005!\0056\0052\002X\007\030\003\130\0053\002Y\0055\005`\005D\002Y\000\196\003a\005H\000\200\000\201\001\198\005J\004\029\002g\003Y\005L\005X\002g\005h\001\230\005j\005k\005p\001\234\005t\001\023\002i\001d\001e\005x\002i\005\138\005\145\005\149\005\173\005\194\005\210\002\024\005\218\002k\000\200\002\024\005\228\002k\000\200\006\020\001\129\001f\001g\006\014\001h\001i\006\015\006\019\001\130\006\"\001\132\001l\006I\006T\006_\006s\006t\001\235\005\212\006x\006\160\006\164\006\174\002o\006\178\005#\002i\002o\007\000\000\000\002i\001\236\000\000\005\213\002\020\002\021\001e\002\024\005\215\002k\000\200\002\024\006\007\002k\000\200\000\000\000\000\000\000\000\000\002X\002l\000\000\002r\005$\002l\005%\002r\002Y\002x\000\000\001\132\002n\002x\002d\001\132\002n\000\000\000\000\000\000\002o\002g\000\000\000\000\002o\000\000\001m\002\020\002\021\001e\000\000\000\000\002z\000\000\000\000\005&\002z\001n\000\000\000\000\000\200\000\000\002X\000\000\000\000\000\000\000\000\002l\000\000\002r\002Y\002l\000\000\003\014\000\000\002x\002q\001\132\002n\002x\000\000\001\132\002n\002g\000\000\000\000\000\000\000\000\005'\002\020\002\021\001e\000\000\000\000\002\020\002\021\001e\005(\002z\005)\002i\000\000\002z\000\000\002X\000\000\001\198\000\000\004!\002X\000\000\002\024\002Y\002k\000\200\001\230\001\129\002Y\002\128\001\234\000\000\001\023\005c\002\127\001\157\002g\001\132\001l\000\000\000\000\002g\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\020\002\021\001e\002i\002o\000\000\005+\000\000\000\000\000\000\000\000\005-\0057\000\000\002\024\002X\002k\000\200\000\000\000\000\001\235\005a\000\000\002Y\000\000\000\000\000\000\000\000\000\000\002\179\000\000\002l\000\000\002r\001\236\000\000\002g\005b\000\000\002x\000\000\001\132\002n\000\000\000\000\002i\002o\000\000\000\000\000\000\002i\000\000\000\000\002\020\002\021\001e\002\024\000\000\002k\000\200\000\000\002\024\002z\002k\000\200\001\198\000\000\004$\002X\000\000\000\000\000\000\000\000\002l\001\230\002r\002Y\000\000\001\234\000\000\001\023\002x\002\190\001\132\002n\000\000\000\000\000\000\002o\002g\000\000\000\000\000\000\002o\000\000\002i\000\000\000\000\002\020\002\021\001e\001\198\000\000\0042\002z\000\000\002\024\000\000\002k\000\200\001\230\000\000\000\000\002X\001\234\002l\001\023\002r\001\235\000\000\002l\002Y\002r\002x\000\000\001\132\002n\002\213\002x\000\000\001\132\002n\001\236\000\000\002g\002\020\002\021\001e\002o\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002z\000\000\002i\000\000\000\000\002z\000\000\000\000\001\235\000\000\000\000\000\000\003T\002\024\000\000\002k\000\200\001\031\000\000\002l\005\015\002r\001\236\002\020\002\021\001e\000\000\002x\000\000\001\132\002n\000\000\000\000\000\000\000\000\000\000\003U\000\000\002X\000\000\000\000\002\020\002\021\001e\001\"\002o\002Y\002i\000\000\000\000\002z\000\000\002\220\001\198\000\000\004\131\002X\000\000\002\024\002g\002k\000\200\001\230\000\000\002Y\000\000\001\234\000\000\001\023\000\000\002\223\000\000\002l\000\000\002r\006\021\000\000\002g\000\000\000\000\002x\000\000\001\132\002n\002\023\002\020\002\021\001e\000\000\000\000\002o\000\000\000\000\006\022\000\000\002\024\006\024\002k\000\200\000\000\002X\000\000\000\000\002z\000\000\006\025\001\235\000\000\002Y\000\000\000\000\000\000\000\000\000\000\002\229\000\000\001\016\002l\002i\002r\001\236\002g\001\023\001$\000\000\002x\000\000\001\132\002n\002\024\003W\002k\000\200\000\000\006\026\000\000\002i\002\020\002\021\001e\000\000\000\000\001\198\000\000\004\137\000\000\000\000\002\024\002z\002k\000\200\001\230\002X\000\000\002l\001\234\000\000\001\023\000\000\000\000\002Y\002o\002m\000\000\001\132\002n\002\232\000\000\006\027\000\000\000\000\000\000\000\000\002g\001%\000\000\006\028\000\000\000\000\002o\002i\000\000\002\020\002\021\001e\000\000\000\000\000\000\002l\000\000\002r\002\024\000\000\002k\000\200\001\235\002x\002X\001\132\002n\006\029\001.\000\000\000\000\000\000\002Y\002l\000\000\002r\001\236\000\000\003\001\000\000\000\000\002x\006\030\001\132\002n\002g\002z\000\000\000\000\000\000\002o\006\031\000\000\002\020\002\021\001e\006!\000\000\000\000\002i\002\020\002\021\001e\000\000\002z\000\000\006#\000\000\002X\000\000\002\024\000\000\002k\000\200\000\000\002X\002Y\002l\000\000\002r\000\000\000\000\006$\002Y\000\000\002x\003\011\001\132\002n\002g\000\000\000\000\000\000\003\016\000\000\000\000\002g\000\000\002\020\002\021\001e\000\000\002o\000\000\002i\002\020\002\021\001e\002z\000\000\001\198\000\000\004\146\000\000\000\000\002\024\000\000\002k\000\200\001\230\002X\003T\000\000\001\234\000\000\001\023\000\000\000\000\002Y\002l\000\000\002r\000\000\000\000\000\000\000\000\000\000\002x\003\018\001\132\002n\002g\000\000\000\000\000\000\005\214\000\000\002o\002i\000\000\000\000\000\000\000\000\000\000\000\000\002i\002\020\002\021\001e\002\024\002z\002k\000\200\001\235\000\000\000\000\002\024\000\000\002k\000\200\000\000\002X\000\000\000\000\002l\000\000\002r\001\236\000\000\002Y\000\000\000\000\002x\000\000\001\132\002n\000\000\000\000\000\000\003\022\000\000\002o\002g\002\023\000\000\000\000\000\000\000\000\002o\000\000\002i\002\020\002\021\001e\002\024\002z\002k\000\200\002\020\002\021\001e\002\024\000\000\002k\000\200\000\000\002X\000\000\002l\000\000\003\014\000\000\000\000\002X\002Y\002l\002x\003\014\001\132\002n\000\000\002Y\000\000\002x\003\030\001\132\002n\002g\000\000\003W\000\000\003$\000\000\002o\002g\000\000\000\000\000\000\000\000\002z\000\000\002i\002\020\002\021\001e\000\000\002z\000\000\000\000\000\000\000\000\000\000\002\024\002l\002k\000\200\000\000\002X\000\000\000\000\002l\002m\003\014\001\132\002n\002Y\000\000\001\198\002x\004\154\001\132\002n\000\000\000\000\000\000\003*\001\230\000\000\002g\000\000\001\234\000\000\001\023\000\000\002o\000\000\002i\002\020\002\021\001e\000\000\002z\000\000\002i\000\000\000\000\000\000\002\024\000\000\002k\000\200\000\000\002X\000\000\002\024\000\000\002k\000\200\000\000\000\000\002Y\002l\000\000\003\014\000\000\000\000\0032\000\000\000\000\002x\001\235\001\132\002n\002g\000\000\000\000\002\020\002\021\001e\002o\000\000\000\000\000\000\000\000\001\236\000\000\002o\002i\000\000\000\000\000\000\002X\002z\000\000\000\000\000\000\000\000\000\000\002\024\002Y\002k\000\200\000\000\000\000\000\000\0037\002l\000\000\003\014\000\000\000\000\000\000\002g\002l\002x\003\014\001\132\002n\000\000\000\000\000\000\002x\000\000\001\132\002n\001\198\000\000\006O\000\000\000\000\002o\000\000\002i\000\000\001\230\000\000\000\000\002z\001\234\000\000\001\023\000\000\000\000\002\024\002z\002k\000\200\002\020\002\021\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002l\000\000\003.\000\000\000\000\002X\000\000\000\000\002x\000\000\001\132\002n\000\000\002Y\002i\002\020\002\021\001e\002o\000\000\000\000\001\235\000\000\003C\000\000\002\024\002g\002k\000\200\000\000\002X\002z\000\000\000\000\000\000\001\236\000\000\000\000\002Y\002\020\002\021\001e\000\000\000\000\000\000\002l\000\000\002r\003H\000\000\000\000\002g\000\000\002x\002X\001\132\002n\002o\000\000\000\000\000\000\000\000\002Y\000\000\002\020\002\021\001e\000\000\000\000\000\000\000\000\000\000\003M\000\000\000\000\002g\002z\000\000\000\000\002X\000\000\000\000\000\000\000\000\002l\002i\002r\002Y\000\000\002\020\002\021\001e\002x\000\000\001\132\002n\002\024\003\\\002k\000\200\002g\000\000\000\000\000\000\002X\000\000\000\000\000\000\000\000\000\000\002i\000\000\002Y\000\000\000\000\002z\000\000\000\000\000\000\000\000\000\000\002\024\003_\002k\000\200\002g\000\000\000\000\002o\000\000\000\000\000\000\000\000\000\000\002i\002\020\002\021\001e\000\000\002\020\002\021\001e\000\000\000\000\000\000\002\024\000\000\002k\000\200\000\000\002X\000\000\000\000\002o\002X\002l\000\000\003\014\002Y\002i\000\000\000\000\002Y\002x\003e\001\132\002n\000\000\003g\000\000\002\024\002g\002k\000\200\000\000\002g\000\000\002o\000\000\000\000\002l\000\000\003\014\000\000\002i\000\000\002z\000\000\002x\000\000\001\132\002n\000\000\000\000\000\000\002\024\000\000\002k\000\200\000\000\000\000\000\000\002o\000\000\002l\000\000\003\014\000\000\000\000\000\000\000\000\002z\002x\000\000\001\132\002n\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002o\000\000\002l\002i\003\014\000\000\000\000\002i\002z\000\000\002x\000\000\001\132\002n\002\024\000\000\002k\000\200\002\024\000\000\002k\000\200\000\000\000\000\002\020\002\021\001e\002l\000\000\003.\000\000\000\000\000\000\002z\000\000\002x\000\000\001\132\002n\002X\002\020\002\021\001e\000\000\000\000\000\000\002o\002Y\000\000\000\000\002o\000\000\000\000\003q\000\000\002X\000\000\000\000\002z\000\000\002g\000\000\000\000\002Y\000\000\000\000\002\020\002\021\001e\003z\000\000\000\000\000\000\002l\000\000\002r\002g\002l\000\000\002r\000\000\002x\000\000\001\132\002n\002x\000\000\001\132\002n\003\182\000\000\000\000\000\000\000\000\000\000\002\020\002\021\001e\000\000\000\000\002\020\002\021\001e\000\000\002z\000\000\000\000\000\000\002z\000\000\002X\000\000\000\000\000\000\000\000\002X\000\000\000\000\002Y\002i\000\000\000\000\000\000\002Y\003}\000\000\000\000\000\000\000\000\003\139\002\024\002g\002k\000\200\000\000\002i\002g\000\000\000\000\000\000\002\020\002\021\001e\000\000\000\000\000\000\002\024\000\000\002k\000\200\000\000\000\000\000\000\000\000\000\000\002X\000\000\000\000\000\000\000\000\000\000\002\023\002o\002Y\000\000\000\000\000\000\000\000\000\000\003\142\000\000\000\000\002\024\000\000\002k\000\200\002g\000\000\002o\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002l\002i\002r\000\000\000\000\000\000\002i\000\000\002x\000\000\001\132\002n\002\024\000\000\002k\000\200\002l\002\024\002r\002k\000\200\000\000\000\000\000\000\002x\000\000\001\132\002n\002\020\002\021\001e\002z\000\000\002\020\002\021\001e\000\000\000\000\000\000\000\000\000\000\000\000\002l\002X\002o\000\000\002i\002z\002X\002o\002m\002Y\001\132\002n\000\000\000\000\002Y\002\024\000\000\002k\000\200\003\152\000\000\000\000\002g\000\000\003\157\000\000\000\000\002g\000\000\002l\000\000\002r\000\000\000\000\002l\000\000\002r\002x\000\000\001\132\002n\000\000\002x\000\000\001\132\002n\000\000\002o\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002z\000\000\000\000\000\000\000\000\002z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002l\000\000\002r\000\000\000\000\000\000\006\021\002i\002x\000\000\001\132\002n\002i\000\000\000\000\002\020\002\021\001e\002\024\000\000\002k\000\200\000\000\002\024\006\022\002k\000\200\006\024\000\000\000\000\002X\002z\000\000\002\020\002\021\001e\006\025\000\000\002Y\000\000\000\000\000\000\000\000\000\000\003\206\000\000\000\000\000\000\002X\000\000\002o\002g\000\000\000\000\000\000\002o\002Y\000\000\000\000\000\000\000\000\000\000\003\219\000\000\000\000\006\026\002\020\002\021\001e\002g\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002l\000\000\003\014\000\000\002X\002l\000\000\003\014\002x\000\000\001\132\002n\002Y\002x\000\000\001\132\002n\000\000\004\007\000\000\000\000\000\000\006\027\000\000\000\000\002g\000\000\000\000\000\000\000\000\006\028\002z\000\000\002i\000\000\000\000\002z\000\000\002\020\002\021\001e\000\000\000\000\000\000\002\024\000\000\002k\000\200\000\000\000\000\000\000\002i\000\000\002X\006(\000\000\000\000\000\000\000\000\000\000\000\000\002Y\002\024\000\000\002k\000\200\000\000\004J\000\000\006\030\000\000\000\000\000\000\000\000\002g\000\000\002o\000\000\006\031\000\000\000\000\000\000\000\000\006!\002i\000\000\000\000\000\000\000\000\002\020\002\021\001e\000\000\006#\002o\002\024\000\000\002k\000\200\000\000\000\000\000\000\000\000\002l\002X\002r\000\000\000\000\000\000\006$\000\000\002x\002Y\001\132\002n\001d\001e\000\000\005w\000\000\000\000\002l\000\000\002r\000\000\002g\000\000\002o\000\000\002x\000\000\001\132\002n\002i\002z\001f\001v\000\000\001h\001i\000\000\000\000\000\000\000\000\002\024\000\000\002k\000\200\000\000\000\000\000\000\000\000\002z\000\000\002l\000\000\002r\000\000\004\023\000\000\000\000\000\000\002x\000\000\001\132\002n\000\000\000\000\000\000\001\031\000\000\000\000\005\012\000\000\000\000\000\000\002o\000\000\001w\000\000\001x\0024\000\000\000\000\002i\002z\000\000\000\000\000\000\002\020\002\021\001e\000\000\000\000\000\000\002\024\001\"\002k\000\200\000\000\000\000\000\000\000\000\002l\002X\002r\002\020\002\021\001e\001\127\000\000\002x\002Y\001\132\002n\000\000\000\000\000\000\005z\000\000\001n\002X\000\000\000\200\000\000\002g\000\000\002o\000\000\002Y\000\000\003\130\000\000\000\000\002z\005\137\000\000\000\000\000\000\005\014\000\000\000\000\002g\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002l\000\000\002r\000\000\000\000\000\000\000\000\000\000\002x\000\000\001\132\002n\000\000\000\000\001\016\000\000\000\000\000\000\000\000\000\000\001\023\005\017\000\000\000\000\000\000\001\129\000\000\002\020\002\021\001e\002i\002z\000\000\001\130\000\000\001\132\001l\000\000\000\000\000\000\000\000\002\024\002X\002k\000\200\000\000\000\000\002i\000\000\000\000\002Y\002\020\002\021\001e\000\000\000\000\005\140\000\000\002\024\000\000\002k\000\200\000\000\002g\000\000\000\000\002X\000\000\002\020\002\021\001e\000\000\005\018\002o\002Y\000\000\000\000\000\000\000\000\000\000\005\153\000\000\001\031\002X\004\220\001 \005\023\002g\005\020\000\000\002o\002Y\000\000\000\000\000\000\000\000\000\000\005\156\000\000\001.\002l\000\000\002r\000\000\002g\000\000\000\000\000\000\002x\001\"\001\132\002n\000\000\000\000\000\000\000\000\000\000\002l\000\000\002r\000\000\000\000\002i\000\000\000\000\002x\000\000\001\132\002n\000\000\000\000\002z\000\000\002\024\000\000\002k\000\200\000\000\000\000\000\000\000\000\000\000\000\000\002\020\002\021\001e\002i\000\000\002z\000\000\000\000\000\000\001*\000\000\000\000\000\000\000\000\002\024\002X\002k\000\200\000\000\000\000\002i\000\000\002o\002Y\000\000\002\020\002\021\001e\000\000\005\177\000\000\002\024\000\000\002k\000\200\000\000\002g\000\000\001\016\000\000\002X\002\020\002\021\001e\001\023\001$\002o\000\000\002Y\002l\000\000\002r\000\000\000\000\005\180\000\000\002X\002x\000\000\001\132\002n\002g\000\000\002o\002Y\000\000\000\000\000\000\000\000\000\000\005\184\000\000\000\000\002l\000\000\002r\000\000\002g\000\000\000\000\002z\002x\000\000\001\132\002n\000\000\000\000\000\000\000\000\001>\002l\000\000\002r\000\000\006\021\002i\001%\000\000\002x\000\000\001\132\002n\000\000\000\000\002z\000\000\002\024\000\000\002k\000\200\000\000\000\000\006\022\000\000\000\000\006\024\000\000\000\000\000\000\000\000\002i\002z\000\000\001.\006\025\000\000\001?\000\000\000\000\000\000\000\000\002\024\000\000\002k\000\200\000\000\002i\000\000\002o\000\000\000\000\002\020\002\021\001e\000\000\000\000\000\000\002\024\000\000\002k\000\200\000\000\000\000\006\026\000\000\000\000\002X\000\000\000\000\000\000\001d\001e\000\000\002o\002Y\002l\000\000\002r\000\000\000\000\006\191\000\000\000\000\002x\000\000\001\132\002n\002g\000\000\002o\001f\001v\000\000\001h\001i\000\000\000\000\006\027\000\000\000\000\002l\000\000\002r\000\000\000\000\006\028\002z\000\000\002x\000\000\001\132\002n\000\000\006Y\000\000\000\000\002l\000\000\002r\000\000\000\000\000\000\000\000\000\000\002x\000\000\001\132\002n\000\000\0061\000\000\002z\000\000\001w\000\000\001x\0024\000\000\000\000\000\000\002\020\002\021\001e\000\000\006\030\000\000\002i\002z\000\000\000\000\000\000\000\000\000\000\006\031\000\000\002X\000\000\002\024\006!\002k\000\200\000\000\000\000\002Y\001\127\002\020\002\021\001e\006#\006\193\000\000\000\000\000\000\000\000\000\000\001n\002g\000\000\000\200\000\000\002X\002\020\002\021\001e\006$\000\000\003\130\000\000\002Y\002o\000\000\001d\001e\000\000\000\000\000\000\002X\000\000\000\000\000\000\000\000\002g\000\000\000\000\002Y\001\031\000\000\000\000\005\012\000\000\000\000\001f\001v\000\000\001h\001i\002l\002g\002r\000\000\000\000\001\166\000\000\000\000\002x\000\000\001\132\002n\000\000\000\000\000\000\000\000\001\"\000\000\001\129\002i\000\000\000\000\000\000\000\000\000\000\000\000\001\130\000\000\001\132\001l\002\024\002z\002k\000\200\000\000\000\000\000\000\000\000\001w\000\000\001x\001\153\000\000\000\000\002i\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\024\000\000\002k\000\200\005\014\002i\000\000\002o\000\000\000\000\000\000\000\000\000\000\000\000\001\127\000\000\002\024\000\000\002k\000\200\000\000\000\000\000\000\000\000\000\000\001n\000\000\000\000\000\200\000\000\000\000\000\000\002o\001\016\002l\000\000\002r\000\000\000\000\001\023\005\017\000\000\002x\000\000\001\132\002n\000\000\000\000\002o\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002l\000\000\004\024\000\000\000\000\000\000\002z\000\000\002x\000\000\001\132\002n\000\000\000\000\000\000\000\000\002l\000\000\004\020\001d\001e\000\000\000\000\000\000\002x\001\129\001\132\002n\000\000\000\000\000\000\002z\005\018\001\130\000\000\001\132\001l\001d\001e\001f\001v\000\000\001h\001i\004\220\000\000\005\022\002z\005\020\001\150\000\000\002\020\002\021\001e\000\000\000\000\000\000\001f\001v\001.\001h\001i\000\000\000\000\000\000\000\000\002X\001\155\000\000\001d\001e\000\000\000\000\000\000\002Y\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001w\000\000\001x\001\153\000\000\002g\000\000\001f\001v\000\000\001h\001i\000\000\000\000\000\000\002\020\002\021\001e\001w\000\000\001x\001\153\000\000\001d\001e\000\000\000\000\000\000\000\000\000\000\002X\001\127\000\000\000\000\000\000\000\000\000\000\000\000\002Y\000\000\000\000\000\000\001n\001f\001v\000\200\001h\001i\000\000\001\127\001w\002g\001x\0024\000\000\000\000\000\000\000\000\000\000\000\000\001n\000\000\000\000\000\200\002i\000\000\000\000\000\000\002\020\002\021\001e\000\000\000\000\000\000\000\000\002\024\000\000\002k\000\200\000\000\000\000\001\127\000\000\002X\000\000\000\000\001w\000\000\001x\002<\000\000\002Y\001n\000\000\000\000\000\200\000\000\000\000\000\000\000\000\000\000\001\129\000\000\003~\002g\000\000\000\000\002o\000\000\001\130\002i\001\132\001l\000\000\000\000\000\000\000\000\001\127\000\000\001\129\000\000\002\024\000\000\002k\000\200\000\000\000\000\001\130\001n\001\132\001l\000\200\000\000\000\000\002l\000\000\003\190\000\000\000\000\000\000\000\000\000\000\002x\000\000\001\132\002n\000\000\000\000\000\000\000\000\000\000\001\129\000\000\002o\000\000\000\000\000\000\000\000\002?\001\130\000\000\001\132\001l\002i\000\000\002z\002\020\002\021\001e\000\000\000\000\002\020\002\021\001e\002\024\000\000\002k\000\200\000\000\000\000\002l\002X\003X\000\000\000\000\000\000\002X\001\129\002x\002Y\001\132\002n\000\000\000\000\002Y\001\130\000\000\001\132\001l\000\000\000\000\000\000\002g\000\000\000\000\000\000\002o\002g\000\000\000\000\000\000\002z\000\000\002\020\002\021\001e\000\000\002\020\002\021\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002X\000\000\000\000\000\000\002X\002l\000\000\002\255\002Y\000\000\000\000\000\000\002Y\002x\000\000\001\132\002n\000\000\000\000\000\000\000\000\002g\000\000\000\000\000\000\002g\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002i\000\000\000\000\002z\000\000\002i\000\000\000\000\000\000\000\000\000\000\002\024\000\000\002k\000\200\000\000\002\024\000\000\002k\000\200\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\020\002\021\001e\000\000\002\020\002\021\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002X\002o\000\000\000\000\002X\002i\002o\000\000\002Y\002i\000\000\000\000\002Y\000\000\000\000\000\000\002\024\000\000\002k\000\200\002\024\002g\002k\000\200\000\000\002g\000\000\000\000\002l\000\000\002t\000\000\000\000\002l\000\000\002v\002x\000\000\001\132\002n\000\000\002x\000\000\001\132\002n\000\000\000\000\000\000\002o\000\000\000\000\000\000\002o\000\000\000\000\000\000\000\000\000\000\000\000\002z\000\000\000\000\000\000\000\000\002z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002l\000\000\002{\000\000\002l\002i\002\130\000\000\002x\002i\001\132\002n\002x\000\000\001\132\002n\002\024\000\000\002k\000\200\002\024\000\000\002k\000\200\002\020\002\021\001e\000\000\002\020\002\021\001e\002z\000\000\000\000\000\000\002z\000\000\000\000\000\000\002X\002\020\002\021\001e\002X\000\000\000\000\000\000\002Y\002o\000\000\000\000\002Y\002o\000\000\000\000\002X\000\000\000\000\000\000\000\000\002g\000\000\000\000\002Y\002g\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002l\002g\002\132\000\000\002l\000\000\002\134\000\000\002x\000\000\001\132\002n\002x\000\000\001\132\002n\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\020\002\021\001e\002z\000\000\000\000\000\000\002z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002X\002i\000\000\000\000\000\000\002i\000\000\000\000\002Y\000\000\000\000\000\000\002\024\000\000\002k\000\200\002\024\002i\002k\000\200\000\000\002g\000\000\000\000\000\000\000\000\000\000\000\000\002\024\000\000\002k\000\200\002\020\002\021\001e\000\000\002\020\002\021\001e\000\000\000\000\000\000\000\000\000\000\002o\000\000\000\000\002X\002o\000\000\000\000\002X\000\000\000\000\000\000\002Y\000\000\000\000\000\000\002Y\002o\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002g\000\000\000\000\002l\002g\002\136\000\000\002l\000\000\002\138\000\000\002x\002i\001\132\002n\002x\000\000\001\132\002n\002l\000\000\002\140\000\000\002\024\000\000\002k\000\200\002x\000\000\001\132\002n\000\000\000\000\000\000\002z\000\000\000\000\000\000\002z\002\020\002\021\001e\000\000\002\020\002\021\001e\000\000\000\000\000\000\000\000\002z\000\000\000\000\000\000\002X\002o\000\000\000\000\002X\002i\000\000\000\000\002Y\002i\000\000\000\000\002Y\000\000\000\000\000\000\002\024\000\000\002k\000\200\002\024\002g\002k\000\200\000\000\002g\000\000\000\000\002l\000\000\002\142\002\020\002\021\001e\000\000\000\000\002x\000\000\001\132\002n\000\000\000\000\001\031\000\000\000\000\001 \002X\000\000\002o\000\000\000\000\000\000\002o\000\000\002Y\000\000\000\000\000\000\000\000\002z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002g\000\000\001\"\000\000\006\140\000\000\000\000\000\000\002l\000\000\002\144\000\000\002l\002i\002\146\000\000\002x\002i\001\132\002n\002x\000\000\001\132\002n\002\024\000\000\002k\000\200\002\024\000\000\002k\000\200\000\000\000\000\000\000\002\020\002\021\001e\000\000\002z\002\020\002\021\001e\002z\000\000\001*\000\000\000\000\000\000\000\000\002X\000\000\000\000\000\000\000\000\002X\002o\000\000\002Y\002i\002o\000\000\000\000\002Y\000\000\000\000\000\000\000\000\000\000\000\000\002\024\002g\002k\000\200\001\016\000\000\002g\000\000\000\000\000\000\001\023\001$\000\000\002l\000\000\002\148\000\000\002l\000\000\002\150\000\000\002x\000\000\001\132\002n\002x\000\000\001\132\002n\000\000\000\000\000\000\002o\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\020\002\021\001e\002z\000\000\000\000\000\000\002z\000\000\000\000\000\000\000\000\000\000\000\000\001>\002X\000\000\000\000\002l\002i\002\152\001%\000\000\002Y\002i\006\147\002x\000\000\001\132\002n\002\024\000\000\002k\000\200\000\000\002\024\002g\002k\000\200\000\000\002\020\002\021\001e\000\000\000\000\002\020\002\021\001e\001.\002z\000\000\001H\000\000\000\000\000\000\002X\000\000\000\000\000\000\000\000\002X\000\000\002o\002Y\000\000\000\000\000\000\002o\002Y\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002g\000\000\000\000\000\000\000\000\002g\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002l\000\000\002\154\000\000\000\000\002l\002i\002\156\002x\000\000\001\132\002n\000\000\002x\000\000\001\132\002n\002\024\000\000\002k\000\200\000\000\000\000\000\000\000\000\000\000\000\000\002\020\002\021\001e\000\000\002z\000\000\000\000\000\000\000\000\002z\000\000\000\000\000\000\000\000\000\000\002X\000\000\000\000\000\000\002i\000\000\000\000\002o\002Y\002i\000\000\000\000\000\000\000\000\000\000\002\024\000\000\002k\000\200\000\000\002\024\002g\002k\000\200\000\000\002\020\002\021\001e\000\000\000\000\000\000\000\000\000\000\000\000\002l\000\000\002\158\000\000\000\000\000\000\002X\000\000\002x\000\000\001\132\002n\000\000\002o\002Y\000\000\000\000\000\000\002o\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002g\000\000\000\000\000\000\002z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002l\000\000\002\160\000\000\000\000\002l\002i\002\162\002x\000\000\001\132\002n\000\000\002x\000\000\001\132\002n\002\024\000\000\002k\000\200\000\000\002\020\002\021\001e\000\000\000\000\000\000\000\000\000\000\000\000\002z\000\000\000\000\000\000\000\000\002z\002X\000\000\000\000\000\000\002\171\001e\000\000\000\000\002Y\002i\000\000\000\000\002o\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\024\002g\002k\000\200\002\225\001v\000\000\001h\001i\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001d\001e\000\000\002l\000\000\002\164\000\000\000\000\000\000\002\188\000\000\002x\000\000\001\132\002n\000\000\002o\002\191\001d\001e\001f\002\192\000\000\001h\001i\000\000\000\000\002\188\000\000\000\000\002\230\002\246\002\247\000\000\002z\002\191\000\000\000\000\001f\002\192\000\000\001h\001i\002l\002i\002\166\002\020\002\021\001e\000\000\000\000\002x\000\000\001\132\002n\002\024\000\000\002k\000\200\000\000\006\021\002X\001\127\000\000\000\000\000\000\000\000\000\000\000\000\002Y\000\000\000\000\000\000\001n\002z\007\020\000\200\000\000\007\021\000\000\000\000\006\024\002g\000\000\000\000\000\000\000\000\002o\000\000\000\000\006\025\000\000\000\000\000\000\001m\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001n\002\250\000\000\000\200\000\000\000\000\000\000\001m\000\000\002l\000\000\002\168\000\000\000\000\006\026\000\000\000\000\002x\001n\001\132\002n\000\200\000\000\000\000\000\000\000\000\000\000\001\129\000\000\000\000\002\020\002\021\001e\000\000\002\193\001\130\002i\001\132\001l\000\000\002z\001\031\000\000\000\000\005\012\002X\000\000\002\024\006\027\002k\000\200\000\000\002\193\002Y\002\195\000\000\006\028\000\000\000\000\001\129\000\000\000\000\000\000\002\020\002\021\001e\002g\001\157\001\"\001\132\001l\000\000\002\194\000\000\000\000\000\000\007\022\001\129\002X\002o\000\000\000\000\002\020\002\021\001e\001\157\002Y\001\132\001l\000\000\000\000\000\000\000\000\000\000\000\000\006\030\000\000\002X\000\000\002g\000\000\000\000\000\000\000\000\006\031\002Y\002l\000\000\003\005\006!\000\000\005\014\000\000\000\000\002x\000\000\001\132\002n\002g\006#\000\000\000\000\000\000\000\000\000\000\002i\002\020\002\021\001e\000\000\000\000\000\000\000\000\000\000\000\000\006$\002\024\002z\002k\000\200\001\016\002X\002\020\002\021\001e\000\000\001\023\005\017\000\000\002Y\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002X\002i\000\000\000\000\000\000\002g\000\000\000\000\002Y\000\000\000\000\002o\002\024\000\000\002k\000\200\000\000\000\000\000\000\000\000\002i\002g\000\000\000\000\002\020\002\021\001e\000\000\000\000\000\000\000\000\002\024\000\000\002k\000\200\000\000\000\000\000\000\002l\002X\003\"\005\018\000\000\000\000\002o\000\000\002x\002Y\001\132\002n\000\000\000\000\000\000\004\220\000\000\005\021\000\000\005\020\000\000\000\000\002g\000\000\000\000\002o\002i\000\000\000\000\000\000\001.\002z\000\000\002l\000\000\003(\000\000\002\024\005#\002k\000\200\002x\002i\001\132\002n\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002l\002\024\003-\002k\000\200\002\020\002\021\001e\002x\000\000\001\132\002n\002z\000\000\005$\006\199\005%\002o\000\000\000\000\002X\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002Y\002i\000\000\002z\000\000\002o\000\000\000\000\000\000\000\000\000\000\000\000\002\024\002g\002k\000\200\002l\005&\0035\000\000\000\000\000\000\000\000\000\000\002x\000\000\001\132\002n\000\000\000\000\000\000\000\000\002l\000\000\003:\000\000\000\000\000\000\000\000\000\000\002x\000\000\001\132\002n\002o\000\000\000\000\002z\000\000\000\000\005'\002\020\002\021\001e\000\000\000\000\000\000\000\000\000\000\005(\000\000\005)\000\000\002z\000\000\000\000\002X\000\000\000\000\000\000\000\000\002l\002i\003<\002Y\002\020\002\021\001e\000\000\002x\000\000\001\132\002n\002\024\005e\002k\000\200\002g\000\000\000\000\002X\002\020\002\021\001e\000\000\000\000\001\031\000\000\002Y\001 \000\000\000\000\002z\002\020\002\021\001e\002X\005+\006\201\001d\001e\002g\005-\0057\002Y\002o\000\000\000\000\002X\000\000\000\000\000\000\005a\001\"\000\000\000\000\002Y\002g\000\000\001f\001v\000\000\001h\001i\000\000\000\000\000\000\000\000\005b\002g\000\000\000\000\002l\000\000\003?\000\000\002i\000\000\000\000\000\000\002x\000\000\001\132\002n\002\020\002\021\001e\002\024\000\000\002k\000\200\000\000\000\000\000\000\006\021\000\000\001*\000\000\000\000\002X\002i\000\000\001w\002z\001x\0024\000\000\002Y\000\000\007\020\000\000\002\024\007\021\002k\000\200\006\024\002i\000\000\000\000\002o\002g\000\000\000\000\000\000\006\025\001\016\000\000\002\024\002i\002k\000\200\001\023\001$\001\127\000\000\000\000\000\000\000\000\000\000\002\024\000\000\002k\000\200\002o\001n\000\000\002l\000\200\003F\000\000\000\000\000\000\000\000\006\026\002x\003\129\001\132\002n\000\000\002o\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002l\002o\003K\000\000\000\000\000\000\006\139\002z\002x\002i\001\132\002n\000\000\001%\000\000\000\000\002l\006\027\003P\000\000\002\024\000\000\002k\000\200\002x\006\028\001\132\002n\002l\000\000\003S\002z\000\000\001\129\002\171\001e\002x\000\000\001\132\002n\001.\001\130\000\000\001\132\001l\007\026\000\000\002z\002\020\002\021\001e\000\000\002o\000\000\002\225\001v\000\000\001h\001i\002z\000\000\000\000\000\000\002X\006\030\000\000\000\000\000\000\000\000\000\000\000\000\002Y\000\000\006\031\000\000\000\000\000\000\000\000\006!\002l\000\000\003\133\002\171\001e\002g\000\000\000\000\002x\006#\001\132\002n\000\000\000\000\000\000\000\000\000\000\002\230\002\246\002\247\002\171\001e\000\000\002\225\001v\006$\001h\001i\000\000\000\000\000\000\002z\002\171\001e\000\000\000\000\000\000\000\000\001d\001e\002\225\001v\000\000\001h\001i\000\000\000\000\000\000\000\000\001\127\000\000\000\000\002\225\001v\000\000\001h\001i\000\000\001f\001v\001n\001h\001i\000\200\002i\002\230\002\246\002\247\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\024\000\000\002k\000\200\002\020\002\021\001e\002\230\002\246\002\247\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\144\002\230\002\246\002\247\001\127\000\000\000\000\000\000\001w\002\022\001x\006\245\000\000\006\247\002o\001n\000\000\000\000\000\200\000\000\000\000\001\127\000\000\000\000\000\000\000\000\001\129\000\000\000\000\000\000\000\000\000\000\001n\001\127\001\130\000\200\001\132\001l\000\000\001\127\000\000\002l\000\000\003\135\001n\000\000\000\000\000\200\004\r\002x\001n\001\132\002n\000\200\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\195\001d\001e\000\000\000\000\000\000\000\000\002z\000\000\001\129\000\000\000\000\005\229\000\000\000\000\000\000\002\023\001\130\000\000\001\132\001l\001f\001v\000\000\001h\001i\001\129\002\024\000\000\002k\000\200\000\000\000\000\000\000\001\130\000\000\001\132\001l\001\129\000\000\000\000\000\000\000\000\000\000\001\129\000\000\001\130\001\031\001\132\001l\001 \000\000\001\130\0012\001\132\001l\001\031\000\000\000\000\001 \000\000\000\000\0012\000\000\001w\000\000\001x\006:\000\000\000\000\000\000\000\000\000\000\0013\001\"\000\000\000\000\000\000\000\000\000\000\0014\000\000\0013\001\"\001d\001e\002l\000\000\000\000\001M\000\000\001d\001e\000\000\002m\001\127\001\132\002n\000\000\000\000\000\000\000\000\000\000\000\000\001f\001v\001n\001h\001i\000\200\000\000\001f\001v\000\000\001h\001i\000\000\001*\001d\001e\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\0018\000\000\000\000\000\000\001f\001v\000\000\001h\001i\0018\000\000\000\000\001\016\001w\000\000\001x\001\158\000\000\001\023\001$\001w\001\016\001x\001\136\000\000\000\000\000\000\001\023\001$\000\000\000\000\001\129\000\000\001d\001e\000\000\000\000\000\000\000\000\001\130\000\000\001\132\001l\000\000\001\127\000\000\000\000\001w\000\000\001x\001\133\001\127\000\000\001f\001v\001n\001h\001i\000\200\000\000\000\000\000\000\001n\001>\000\000\000\200\000\000\000\000\000\000\000\000\001%\000\000\001>\000\000\001F\000\000\000\000\000\000\001\127\001%\000\000\001d\001e\001F\000\000\000\000\000\000\001d\001e\001n\000\000\000\000\000\200\000\000\000\000\000\000\001w\001.\001x\001z\001H\001f\001v\000\000\001h\001i\001.\001f\001v\001H\001h\001i\000\000\000\000\001\129\000\000\000\000\000\000\000\000\001d\001e\001\129\001\130\000\000\001\132\001l\000\000\001\127\000\000\001\130\000\000\001\132\001l\000\000\000\000\000\000\000\000\000\000\001n\001f\001v\000\200\001h\001i\001w\000\000\001x\001}\001\129\000\000\001w\000\000\001x\001\128\000\000\000\000\001\130\000\000\001\132\001l\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001d\001e\000\000\000\000\000\000\001\127\000\000\000\000\000\000\000\000\000\000\001\127\001w\000\000\001x\001\131\001n\000\000\000\000\000\200\001f\001v\001n\001h\001i\000\200\000\000\001\129\000\000\000\000\000\000\000\000\001d\001e\000\000\001\130\000\000\001\132\001l\000\000\000\000\000\000\000\000\001\127\000\000\000\000\000\000\000\000\000\000\001d\001e\000\000\001f\001v\001n\001h\001i\000\200\000\000\000\000\000\000\000\000\000\000\001w\000\000\001x\001\141\000\000\000\000\001f\001v\000\000\001h\001i\000\000\001\129\000\000\000\000\000\000\001d\001e\001\129\000\000\001\130\000\000\001\132\001l\000\000\002\221\001\130\000\000\001\132\001l\000\000\001\127\001w\002\224\001x\001\144\001f\002\192\000\000\001h\001i\000\000\001n\000\000\000\000\000\200\000\000\000\000\000\000\001w\001\129\001x\002N\000\000\000\000\000\000\000\000\000\000\001\130\000\000\001\132\001l\000\000\001\127\000\000\001d\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001n\000\000\000\000\000\200\000\000\000\000\001\127\000\000\000\000\000\000\000\000\001f\001v\000\000\001h\001i\000\000\001n\000\000\000\000\000\200\000\000\000\000\000\000\000\000\001d\001e\001\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\130\001m\001\132\001l\000\000\000\000\000\000\001d\001e\000\000\001f\001v\001n\001h\001i\000\200\000\000\000\000\000\000\001w\000\000\001x\002\235\000\000\001\129\000\000\000\000\001f\001v\000\000\001h\001i\001\130\000\000\001\132\001l\000\000\000\000\000\000\001d\001e\001\129\000\000\000\000\000\000\000\000\002\193\000\000\000\000\001\130\001\127\001\132\001l\001w\000\000\001x\002\238\000\000\000\000\001f\001v\001n\001h\001i\000\200\000\000\002\020\002\021\001e\000\000\001w\001\129\001x\002\241\000\000\000\000\000\000\000\000\000\000\001\157\000\000\001\132\001l\000\000\001\127\000\000\001d\001e\000\000\002S\001\031\000\000\000\000\001 \000\000\001n\001I\000\000\000\200\000\000\000\000\001\127\001w\000\000\001x\002\249\001f\001v\000\000\001h\001i\000\000\001n\000\000\000\000\000\200\001K\001\"\000\000\000\000\001\129\000\000\004\213\000\000\000\000\000\000\000\000\000\000\001\130\001\031\001\132\001l\001 \001\127\000\000\001I\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001n\000\000\000\000\000\200\000\000\001w\000\000\001x\004H\000\000\001\129\001K\001\"\000\000\000\000\000\000\001*\002\023\001\130\000\000\001\132\001l\000\000\000\000\000\000\000\000\000\000\001\129\002\024\000\000\002k\000\200\000\000\0018\000\000\001\130\001\127\001\132\001l\000\000\000\000\000\000\001d\001e\000\000\001\016\000\000\001n\000\000\000\000\000\200\001\023\001$\000\000\001\031\001*\000\000\001 \000\000\001\129\0012\000\000\001f\002\192\000\000\001h\001i\001\130\000\000\001\132\001l\000\000\0018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0017\001\"\000\000\000\000\001\016\000\000\000\000\002l\001d\001e\001\023\001$\000\000\000\000\000\000\002m\001>\001\132\002n\000\000\000\000\000\000\000\000\001%\000\000\000\000\001\129\005\011\001f\002\192\000\000\001h\001i\000\000\001\130\000\000\001\132\001l\000\000\000\000\000\000\000\000\000\000\000\000\001*\000\000\000\000\000\000\001d\001e\001.\000\000\000\000\001H\000\000\001>\001m\000\000\000\000\000\000\000\000\0018\001%\001d\001e\000\000\001F\001n\001f\002\192\000\200\001h\001i\001\016\000\000\000\000\001d\001e\000\000\001\023\001$\000\000\000\000\001f\002\192\000\000\001h\001i\000\000\001.\000\000\000\000\001H\005\157\000\000\000\000\001f\002\192\000\000\001h\001i\003r\001m\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001n\000\000\000\000\000\200\000\000\000\000\000\000\003t\000\000\000\000\000\000\001>\000\000\001\129\000\000\000\000\000\000\000\000\001%\000\000\000\000\001\157\001F\001\132\001l\000\000\000\000\000\000\000\000\001m\000\000\000\000\000\000\000\000\003r\000\000\000\000\000\000\000\000\000\000\001n\000\000\000\000\000\200\001m\001.\000\000\000\000\001H\000\000\000\000\000\000\000\000\003s\000\000\001n\000\000\001m\000\200\001\129\001d\001e\000\000\000\000\000\000\000\000\000\000\001\157\001n\001\132\001l\000\200\000\000\000\000\003r\000\000\000\000\005\181\000\000\000\000\001f\002\192\000\000\001h\001i\000\000\000\000\000\000\000\000\006\b\000\000\000\000\000\000\003w\000\000\000\000\000\000\001d\001e\001\129\000\000\000\000\002\193\000\000\000\000\000\000\000\000\001\157\000\000\001\132\001l\000\000\000\000\000\000\001\129\000\000\000\000\001f\002\192\000\000\001h\001i\001\157\000\000\001\132\001l\000\000\001\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\157\006\n\001\132\001l\001d\001e\000\000\000\000\000\000\000\000\000\000\001d\001e\000\000\000\000\000\000\001d\001e\000\000\001m\000\000\000\000\000\000\000\000\001f\002\192\000\000\001h\001i\000\000\001n\001f\002\192\000\200\001h\001i\001f\002\192\000\000\001h\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\001d\001e\001m\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\193\000\000\005#\001n\000\000\000\000\000\200\000\000\000\000\000\000\001f\002\192\000\000\001h\001i\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\129\000\000\000\000\000\000\000\000\005$\006\181\005%\001\157\001m\001\132\001l\005\208\000\000\000\000\001\031\001m\000\000\001 \000\000\001n\001m\000\000\000\200\000\000\000\000\000\000\001n\000\000\000\000\000\200\000\000\001n\000\000\000\000\000\200\005&\001\129\000\000\000\000\000\000\000\000\001\"\000\000\000\000\001\157\000\000\001\132\001l\000\000\000\000\000\000\004\198\000\000\005\208\000\000\000\000\000\000\005\221\001m\000\000\006\b\000\000\000\000\000\000\000\000\006\b\005\154\001\031\005'\001n\001 \000\000\000\200\000\000\000\000\000\000\000\000\005(\001\129\005)\000\000\000\000\000\000\000\000\001*\001\129\001\157\000\000\001\132\001l\001\129\000\000\000\000\001\157\001\"\001\132\001l\000\000\001\157\005\220\001\132\001l\005e\003v\003\237\000\000\001\031\006\t\001\031\001 \000\000\001 \006\017\001\016\000\000\000\000\000\000\000\000\006}\001\023\001$\000\000\000\000\000\000\000\000\005+\000\000\000\000\001\129\000\000\005-\0057\006\021\001\"\000\000\001\"\001\157\001*\001\132\001l\005a\000\000\000\000\004\198\000\000\004\198\000\000\007\020\000\000\000\000\007\021\000\000\000\000\006\024\000\000\000\000\005b\000\000\005\168\000\000\005\178\000\000\006\025\000\000\001>\000\000\001\016\000\000\000\000\000\000\000\000\001%\001\023\001$\000\000\004\203\001*\000\000\001*\001d\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\026\000\000\002\020\002\021\001e\000\000\000\000\001.\001f\002\177\001H\001h\001i\000\000\001\016\000\000\001\016\000\000\000\000\000\000\001\023\001$\001\023\001$\001\031\003T\001>\001 \000\000\000\000\000\000\000\000\000\000\001%\006\027\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\028\001\031\000\000\000\000\001 \000\000\000\000\000\000\000\000\001\"\001\031\000\000\000\000\001 \000\000\000\000\000\000\000\000\001.\002\214\007\031\003\244\000\000\001>\000\000\001>\000\000\000\000\001\"\000\000\001%\000\000\001%\000\000\004\203\000\000\004\203\001\"\000\000\006\030\001m\000\000\000\000\000\000\000\000\000\000\005#\003\237\006\031\000\000\000\000\001n\001*\006!\000\200\002\023\000\000\001.\000\000\001.\001H\003\240\001H\006#\000\000\000\000\002\024\000\000\002k\000\200\000\000\001*\001\031\000\000\005$\001 \005%\000\000\000\000\006$\001*\001\016\000\000\000\000\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\000\000\000\000\001\"\001\016\003V\000\000\000\000\005\203\005&\001\023\001$\000\000\001\016\001\129\000\000\000\000\000\000\001\031\001\023\001$\001 \001\157\000\000\001\132\001l\000\000\000\000\000\000\002l\001\031\000\000\000\000\001 \000\000\000\000\001>\002m\000\000\001\132\002n\000\000\005'\001%\000\000\001\"\001*\002\185\000\000\000\000\000\000\005(\000\000\005)\000\000\001>\000\000\001\"\000\000\000\000\000\000\000\000\001%\000\000\001>\000\000\004\231\000\000\000\000\004\234\001.\001%\006\021\001H\000\000\001\016\005*\000\000\000\000\000\000\000\000\001\023\001$\000\000\001\031\000\000\000\000\001 \001*\001.\007\011\000\000\001H\006\024\001\031\000\000\006\225\001 \001.\005+\001*\003\244\006\025\000\000\005-\0057\000\000\000\000\000\000\000\000\000\000\001\"\000\000\000\000\005a\000\000\000\000\001\016\000\000\000\000\000\000\001\"\000\000\001\023\001$\001\031\001>\000\000\001 \001\016\005b\006\026\000\000\001%\000\000\001\023\001$\004\218\000\000\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\001\"\000\000\001*\000\000\000\000\000\000\001\031\000\000\001.\001 \000\000\001H\001*\006\027\000\000\000\000\001>\000\000\001\"\000\000\000\000\006\028\000\000\001%\000\000\000\000\001<\004\231\001>\000\000\005\249\001\016\000\000\001\"\000\000\001%\000\000\001\023\001$\006\226\000\000\001\016\007\012\001*\000\000\000\000\000\000\001\023\001$\000\000\001.\000\000\000\000\001H\000\000\000\000\000\000\000\000\000\000\000\000\006\030\001*\001.\000\000\000\000\001H\000\000\001\031\000\000\006\031\001 \000\000\001\016\000\000\006!\000\000\001*\001\031\001\023\001$\001 \000\000\001>\000\000\006#\000\000\000\000\000\000\000\000\001%\001\016\000\000\001>\006\186\001\"\001\031\001\023\001$\001 \001%\006$\000\000\000\000\001X\001\"\001\016\000\000\000\000\000\000\000\000\000\000\001\023\001$\002\020\002\021\001e\001.\000\000\000\000\001H\000\000\000\000\001\"\001>\000\000\000\000\001.\000\000\000\000\001H\001%\002\020\002\021\001e\001\174\000\000\002U\001*\002\020\002\021\001e\001>\000\000\000\000\000\000\000\000\000\000\001*\001%\000\000\000\000\000\000\000\000\000\000\002_\000\000\001>\001.\000\000\000\000\001H\002j\000\000\001%\000\000\001*\001\016\001\212\002\020\002\021\001e\000\000\001\023\001$\000\000\001.\001\016\000\000\001D\000\000\000\000\000\000\001\023\001$\000\000\001\031\000\000\000\000\001 \000\000\001.\002y\000\000\001H\001\016\000\000\000\000\000\000\000\000\000\000\001\023\001$\000\000\001\031\000\000\000\000\001 \000\000\002\023\000\000\000\000\000\000\001\"\000\000\000\000\000\000\000\000\001>\000\000\002\024\000\000\002k\000\200\000\000\001%\000\000\002\023\001>\001\214\000\000\001\"\000\000\000\000\002\023\001%\000\000\000\000\002\024\002+\002k\000\200\000\000\000\000\000\000\002\024\001>\002k\000\200\000\000\000\000\000\000\001.\001%\000\000\001H\001*\002>\000\000\000\000\000\000\000\000\001.\000\000\002\023\001H\000\000\000\000\000\000\001\031\000\000\000\000\001 \000\000\001*\002\024\000\000\002k\000\200\002l\001.\000\000\000\000\001H\000\000\001\016\000\000\002m\000\000\001\132\002n\001\023\001$\000\000\000\000\000\000\001\"\002l\000\000\000\000\000\000\000\000\000\000\001\016\002l\002m\000\000\001\132\002n\001\023\001$\000\000\002m\000\000\001\132\002n\000\000\000\000\000\000\001\031\000\000\000\000\001 \000\000\000\000\000\000\000\000\000\000\001\031\000\000\000\000\001 \000\000\000\000\002l\000\000\001>\001\031\000\000\001*\001 \000\000\002m\001%\001\132\002n\001\"\002\182\000\000\000\000\000\000\000\000\000\000\000\000\001>\001\"\000\000\002\020\002\021\001e\000\000\001%\000\000\000\000\001\"\002\187\000\000\000\000\001\016\000\000\001.\000\000\000\000\001H\001\023\001$\000\000\000\000\001\031\000\000\003\027\001 \000\000\000\000\000\000\000\000\000\000\001\031\001.\001*\001 \001H\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\001*\000\000\000\000\000\000\000\000\000\000\000\000\001\"\000\000\000\000\000\000\001\016\001>\001\031\000\000\000\000\001 \001\023\001$\001%\001\016\000\000\000\000\002\204\000\000\000\000\001\023\001$\001\031\001\016\001\031\001 \000\000\001 \000\000\001\023\001$\000\000\000\000\000\000\001\"\001*\000\000\000\000\000\000\002\023\001.\000\000\000\000\001H\001*\000\000\000\000\000\000\000\000\001\"\002\024\001\"\002k\000\200\000\000\000\000\001>\000\000\000\000\000\000\000\000\000\000\000\000\001%\001\016\001>\000\000\002\211\000\000\000\000\001\023\001$\001%\001\016\001>\000\000\002\218\001*\000\000\001\023\001$\001%\000\000\001\031\000\000\002\227\001 \000\000\000\000\000\000\001.\000\000\001*\001H\001*\000\000\000\000\000\000\000\000\001.\000\000\000\000\001H\000\000\000\000\000\000\001\016\000\000\001.\002l\001\"\001H\001\023\001$\000\000\001>\000\000\002m\000\000\001\132\002n\001\016\001%\001\016\001>\000\000\004W\001\023\001$\001\023\001$\001%\000\000\001\031\000\000\004\175\005\012\000\000\000\000\000\000\000\000\000\000\001\031\000\000\001\031\005\012\000\000\001 \000\000\001.\000\000\000\000\001H\001*\000\000\000\000\000\000\001>\001.\001\031\001\"\001H\001 \000\000\001%\000\000\000\000\000\000\004\187\001\"\000\000\001\"\001>\000\000\001>\001\031\000\000\000\000\001 \001%\000\000\001%\001\016\004\200\000\000\004\217\001\"\000\000\001\023\001$\001\031\001.\001\031\001 \001H\005\012\000\000\000\000\000\000\000\000\000\000\000\000\001\"\005\014\000\000\000\000\001.\000\000\001.\001H\000\000\001H\005\014\000\000\001*\000\000\000\000\001\"\000\000\001\"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001*\000\000\000\000\001\016\001>\000\000\000\000\000\000\000\000\001\023\005\017\001%\001\016\000\000\001\016\004\233\001*\000\000\001\023\005\017\001\023\001$\001\031\000\000\000\000\005\012\000\000\000\000\000\000\001\016\000\000\001*\000\000\005\014\000\000\001\023\001$\000\000\001.\000\000\000\000\001H\000\000\000\000\000\000\001\016\000\000\000\000\000\000\001\"\000\000\001\023\001$\000\000\001\031\000\000\000\000\001 \000\000\000\000\001\016\005\018\001\016\000\000\000\000\001>\001\023\001$\001\023\005\017\005\018\001\031\001%\004\220\001 \005\019\005\133\005\020\000\000\000\000\001>\001\"\004\220\000\000\005\031\000\000\005\020\001%\001.\000\000\000\000\005\151\005\014\000\000\000\000\000\000\001>\001.\001\"\001.\000\000\000\000\001H\001%\000\000\000\000\000\000\005\175\000\000\000\000\000\000\001>\000\000\001\031\001.\000\000\001 \001H\001%\000\000\005\018\001\016\006=\000\000\001*\000\000\000\000\001\023\005\017\000\000\001.\000\000\004\220\001H\005\235\000\000\005\020\000\000\000\000\000\000\001\"\001*\000\000\000\000\000\000\001.\001\031\001.\001H\001 \000\000\000\000\000\000\001\016\001\031\000\000\000\000\001 \000\000\001\023\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\001\"\000\000\000\000\001\023\001$\000\000\005\018\000\000\001\"\000\000\001*\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\220\000\000\006\005\000\000\005\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001>\000\000\001.\000\000\000\000\000\000\000\000\001%\001\016\000\000\000\000\006\146\001*\000\000\001\023\001$\000\000\001>\000\000\000\000\001*\000\000\000\000\000\000\001%\000\000\000\000\000\000\006\150\000\000\000\000\000\000\000\000\000\000\001.\000\000\000\000\001H\000\000\000\000\000\000\001\016\000\000\000\000\000\000\000\000\000\000\001\023\001$\001\016\000\000\001.\000\000\000\000\001H\001\023\001$\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\001>\001.\000\000\000\000\001\207\000\000\000\000\001%\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\001.\000\000\000\000\001\209\000\000\000\000\000\000\000\000\001.\000\000\000\000\003\239"))
and semantic_action =
[|
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3641 "parsing/parser.mly"
+# 3657 "parsing/parser.mly"
( "+" )
-# 1338 "parsing/parser.ml"
+# 1342 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3642 "parsing/parser.mly"
+# 3658 "parsing/parser.mly"
( "+." )
-# 1363 "parsing/parser.ml"
+# 1367 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) =
-# 3198 "parsing/parser.mly"
+# 3214 "parsing/parser.mly"
( _1 )
-# 1388 "parsing/parser.ml"
+# 1392 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_tyvar_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3201 "parsing/parser.mly"
+# 3217 "parsing/parser.mly"
( Ptyp_alias(ty, tyvar) )
-# 1435 "parsing/parser.ml"
+# 1439 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_tyvar_, _startpos_ty_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 854 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 1444 "parsing/parser.ml"
+# 1448 "parsing/parser.ml"
in
-# 3203 "parsing/parser.mly"
+# 3219 "parsing/parser.mly"
( _1 )
-# 1450 "parsing/parser.ml"
+# 1454 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (let_binding) = let attrs2 =
let _1 = _1_inlined2 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 1498 "parsing/parser.ml"
+# 1502 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined2_ in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 1507 "parsing/parser.ml"
+# 1511 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2478 "parsing/parser.mly"
+# 2480 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
mklb ~loc:_sloc false body attrs
)
-# 1519 "parsing/parser.ml"
+# 1523 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3528 "parsing/parser.mly"
+# 3544 "parsing/parser.mly"
( _1 )
-# 1544 "parsing/parser.ml"
+# 1548 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3529 "parsing/parser.mly"
+# 3545 "parsing/parser.mly"
( Lident _1 )
-# 1569 "parsing/parser.ml"
+# 1573 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.core_type) =
-# 3259 "parsing/parser.mly"
+# 3275 "parsing/parser.mly"
( _2 )
-# 1608 "parsing/parser.ml"
+# 1612 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__5_ in
let _v : (Parsetree.core_type) = let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
- let _1 =
- let _1 =
-# 3320 "parsing/parser.mly"
- ( Ptyp_package (package_type_of_module_type _1) )
-# 1671 "parsing/parser.ml"
- in
- let _endpos = _endpos__1_ in
- let _symbolstartpos = _startpos__1_ in
- let _sloc = (_symbolstartpos, _endpos) in
-
-# 850 "parsing/parser.mly"
- ( mktyp ~loc:_sloc _1 )
-# 1679 "parsing/parser.ml"
-
- in
+ let _endpos = _endpos__1_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
-# 3321 "parsing/parser.mly"
- ( _1 )
-# 1685 "parsing/parser.ml"
+# 3335 "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 )
+# 1679 "parsing/parser.ml"
in
let _3 =
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 1695 "parsing/parser.ml"
+# 1689 "parsing/parser.ml"
in
-# 3742 "parsing/parser.mly"
+# 3758 "parsing/parser.mly"
( _1, _2 )
-# 1701 "parsing/parser.ml"
+# 1695 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3261 "parsing/parser.mly"
+# 3277 "parsing/parser.mly"
( wrap_typ_attrs ~loc:_sloc (reloc_typ ~loc:_sloc _4) _3 )
-# 1710 "parsing/parser.ml"
+# 1704 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3264 "parsing/parser.mly"
+# 3280 "parsing/parser.mly"
( Ptyp_var _2 )
-# 1743 "parsing/parser.ml"
+# 1737 "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
-# 850 "parsing/parser.mly"
+# 854 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 1752 "parsing/parser.ml"
+# 1746 "parsing/parser.ml"
in
-# 3296 "parsing/parser.mly"
+# 3312 "parsing/parser.mly"
( _1 )
-# 1758 "parsing/parser.ml"
+# 1752 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3266 "parsing/parser.mly"
+# 3282 "parsing/parser.mly"
( Ptyp_any )
-# 1784 "parsing/parser.ml"
+# 1778 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 854 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 1792 "parsing/parser.ml"
+# 1786 "parsing/parser.ml"
in
-# 3296 "parsing/parser.mly"
+# 3312 "parsing/parser.mly"
( _1 )
-# 1798 "parsing/parser.ml"
+# 1792 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 1829 "parsing/parser.ml"
+# 1823 "parsing/parser.ml"
in
let tys =
-# 3311 "parsing/parser.mly"
+# 3327 "parsing/parser.mly"
( [] )
-# 1835 "parsing/parser.ml"
+# 1829 "parsing/parser.ml"
in
-# 3269 "parsing/parser.mly"
+# 3285 "parsing/parser.mly"
( Ptyp_constr(tid, tys) )
-# 1840 "parsing/parser.ml"
+# 1834 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 854 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 1849 "parsing/parser.ml"
+# 1843 "parsing/parser.ml"
in
-# 3296 "parsing/parser.mly"
+# 3312 "parsing/parser.mly"
( _1 )
-# 1855 "parsing/parser.ml"
+# 1849 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 1893 "parsing/parser.ml"
+# 1887 "parsing/parser.ml"
in
let tys =
-# 3313 "parsing/parser.mly"
+# 3329 "parsing/parser.mly"
( [ty] )
-# 1899 "parsing/parser.ml"
+# 1893 "parsing/parser.ml"
in
-# 3269 "parsing/parser.mly"
+# 3285 "parsing/parser.mly"
( Ptyp_constr(tid, tys) )
-# 1904 "parsing/parser.ml"
+# 1898 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_ty_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 854 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 1914 "parsing/parser.ml"
+# 1908 "parsing/parser.ml"
in
-# 3296 "parsing/parser.mly"
+# 3312 "parsing/parser.mly"
( _1 )
-# 1920 "parsing/parser.ml"
+# 1914 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 1973 "parsing/parser.ml"
+# 1967 "parsing/parser.ml"
in
let tys =
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 1981 "parsing/parser.ml"
+# 1975 "parsing/parser.ml"
in
-# 975 "parsing/parser.mly"
+# 979 "parsing/parser.mly"
( xs )
-# 1986 "parsing/parser.ml"
+# 1980 "parsing/parser.ml"
in
-# 3315 "parsing/parser.mly"
+# 3331 "parsing/parser.mly"
( tys )
-# 1992 "parsing/parser.ml"
+# 1986 "parsing/parser.ml"
in
-# 3269 "parsing/parser.mly"
+# 3285 "parsing/parser.mly"
( Ptyp_constr(tid, tys) )
-# 1998 "parsing/parser.ml"
+# 1992 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 854 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2008 "parsing/parser.ml"
+# 2002 "parsing/parser.ml"
in
-# 3296 "parsing/parser.mly"
+# 3312 "parsing/parser.mly"
( _1 )
-# 2014 "parsing/parser.ml"
+# 2008 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3271 "parsing/parser.mly"
+# 3287 "parsing/parser.mly"
( let (f, c) = _2 in Ptyp_object (f, c) )
-# 2054 "parsing/parser.ml"
+# 2048 "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
-# 850 "parsing/parser.mly"
+# 854 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2063 "parsing/parser.ml"
+# 2057 "parsing/parser.ml"
in
-# 3296 "parsing/parser.mly"
+# 3312 "parsing/parser.mly"
( _1 )
-# 2069 "parsing/parser.ml"
+# 2063 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3273 "parsing/parser.mly"
+# 3289 "parsing/parser.mly"
( Ptyp_object ([], Closed) )
-# 2102 "parsing/parser.ml"
+# 2096 "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
-# 850 "parsing/parser.mly"
+# 854 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2111 "parsing/parser.ml"
+# 2105 "parsing/parser.ml"
in
-# 3296 "parsing/parser.mly"
+# 3312 "parsing/parser.mly"
( _1 )
-# 2117 "parsing/parser.ml"
+# 2111 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 2155 "parsing/parser.ml"
+# 2149 "parsing/parser.ml"
in
let tys =
-# 3311 "parsing/parser.mly"
+# 3327 "parsing/parser.mly"
( [] )
-# 2161 "parsing/parser.ml"
+# 2155 "parsing/parser.ml"
in
-# 3277 "parsing/parser.mly"
+# 3293 "parsing/parser.mly"
( Ptyp_class(cid, tys) )
-# 2166 "parsing/parser.ml"
+# 2160 "parsing/parser.ml"
in
let _startpos__1_ = _startpos__2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 854 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2176 "parsing/parser.ml"
+# 2170 "parsing/parser.ml"
in
-# 3296 "parsing/parser.mly"
+# 3312 "parsing/parser.mly"
( _1 )
-# 2182 "parsing/parser.ml"
+# 2176 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 2227 "parsing/parser.ml"
+# 2221 "parsing/parser.ml"
in
let tys =
-# 3313 "parsing/parser.mly"
+# 3329 "parsing/parser.mly"
( [ty] )
-# 2233 "parsing/parser.ml"
+# 2227 "parsing/parser.ml"
in
-# 3277 "parsing/parser.mly"
+# 3293 "parsing/parser.mly"
( Ptyp_class(cid, tys) )
-# 2238 "parsing/parser.ml"
+# 2232 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_ty_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 854 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2248 "parsing/parser.ml"
+# 2242 "parsing/parser.ml"
in
-# 3296 "parsing/parser.mly"
+# 3312 "parsing/parser.mly"
( _1 )
-# 2254 "parsing/parser.ml"
+# 2248 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 2314 "parsing/parser.ml"
+# 2308 "parsing/parser.ml"
in
let tys =
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 2322 "parsing/parser.ml"
+# 2316 "parsing/parser.ml"
in
-# 975 "parsing/parser.mly"
+# 979 "parsing/parser.mly"
( xs )
-# 2327 "parsing/parser.ml"
+# 2321 "parsing/parser.ml"
in
-# 3315 "parsing/parser.mly"
+# 3331 "parsing/parser.mly"
( tys )
-# 2333 "parsing/parser.ml"
+# 2327 "parsing/parser.ml"
in
-# 3277 "parsing/parser.mly"
+# 3293 "parsing/parser.mly"
( Ptyp_class(cid, tys) )
-# 2339 "parsing/parser.ml"
+# 2333 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 854 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2349 "parsing/parser.ml"
+# 2343 "parsing/parser.ml"
in
-# 3296 "parsing/parser.mly"
+# 3312 "parsing/parser.mly"
( _1 )
-# 2355 "parsing/parser.ml"
+# 2349 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3280 "parsing/parser.mly"
+# 3296 "parsing/parser.mly"
( Ptyp_variant([_2], Closed, None) )
-# 2395 "parsing/parser.ml"
+# 2389 "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
-# 850 "parsing/parser.mly"
+# 854 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2404 "parsing/parser.ml"
+# 2398 "parsing/parser.ml"
in
-# 3296 "parsing/parser.mly"
+# 3312 "parsing/parser.mly"
( _1 )
-# 2410 "parsing/parser.ml"
+# 2404 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 2460 "parsing/parser.ml"
+# 2454 "parsing/parser.ml"
in
-# 947 "parsing/parser.mly"
+# 951 "parsing/parser.mly"
( xs )
-# 2465 "parsing/parser.ml"
+# 2459 "parsing/parser.ml"
in
-# 3325 "parsing/parser.mly"
+# 3341 "parsing/parser.mly"
( _1 )
-# 2471 "parsing/parser.ml"
+# 2465 "parsing/parser.ml"
in
-# 3282 "parsing/parser.mly"
+# 3298 "parsing/parser.mly"
( Ptyp_variant(_3, Closed, None) )
-# 2477 "parsing/parser.ml"
+# 2471 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 854 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2487 "parsing/parser.ml"
+# 2481 "parsing/parser.ml"
in
-# 3296 "parsing/parser.mly"
+# 3312 "parsing/parser.mly"
( _1 )
-# 2493 "parsing/parser.ml"
+# 2487 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 2550 "parsing/parser.ml"
+# 2544 "parsing/parser.ml"
in
-# 947 "parsing/parser.mly"
+# 951 "parsing/parser.mly"
( xs )
-# 2555 "parsing/parser.ml"
+# 2549 "parsing/parser.ml"
in
-# 3325 "parsing/parser.mly"
+# 3341 "parsing/parser.mly"
( _1 )
-# 2561 "parsing/parser.ml"
+# 2555 "parsing/parser.ml"
in
-# 3284 "parsing/parser.mly"
+# 3300 "parsing/parser.mly"
( Ptyp_variant(_2 :: _4, Closed, None) )
-# 2567 "parsing/parser.ml"
+# 2561 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 854 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2577 "parsing/parser.ml"
+# 2571 "parsing/parser.ml"
in
-# 3296 "parsing/parser.mly"
+# 3312 "parsing/parser.mly"
( _1 )
-# 2583 "parsing/parser.ml"
+# 2577 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 2633 "parsing/parser.ml"
+# 2627 "parsing/parser.ml"
in
-# 947 "parsing/parser.mly"
+# 951 "parsing/parser.mly"
( xs )
-# 2638 "parsing/parser.ml"
+# 2632 "parsing/parser.ml"
in
-# 3325 "parsing/parser.mly"
+# 3341 "parsing/parser.mly"
( _1 )
-# 2644 "parsing/parser.ml"
+# 2638 "parsing/parser.ml"
in
-# 3286 "parsing/parser.mly"
+# 3302 "parsing/parser.mly"
( Ptyp_variant(_3, Open, None) )
-# 2650 "parsing/parser.ml"
+# 2644 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 854 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2660 "parsing/parser.ml"
+# 2654 "parsing/parser.ml"
in
-# 3296 "parsing/parser.mly"
+# 3312 "parsing/parser.mly"
( _1 )
-# 2666 "parsing/parser.ml"
+# 2660 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3288 "parsing/parser.mly"
+# 3304 "parsing/parser.mly"
( Ptyp_variant([], Open, None) )
-# 2699 "parsing/parser.ml"
+# 2693 "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
-# 850 "parsing/parser.mly"
+# 854 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2708 "parsing/parser.ml"
+# 2702 "parsing/parser.ml"
in
-# 3296 "parsing/parser.mly"
+# 3312 "parsing/parser.mly"
( _1 )
-# 2714 "parsing/parser.ml"
+# 2708 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 2764 "parsing/parser.ml"
+# 2758 "parsing/parser.ml"
in
-# 947 "parsing/parser.mly"
+# 951 "parsing/parser.mly"
( xs )
-# 2769 "parsing/parser.ml"
+# 2763 "parsing/parser.ml"
in
-# 3325 "parsing/parser.mly"
+# 3341 "parsing/parser.mly"
( _1 )
-# 2775 "parsing/parser.ml"
+# 2769 "parsing/parser.ml"
in
-# 3290 "parsing/parser.mly"
+# 3306 "parsing/parser.mly"
( Ptyp_variant(_3, Closed, Some []) )
-# 2781 "parsing/parser.ml"
+# 2775 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 854 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2791 "parsing/parser.ml"
+# 2785 "parsing/parser.ml"
in
-# 3296 "parsing/parser.mly"
+# 3312 "parsing/parser.mly"
( _1 )
-# 2797 "parsing/parser.ml"
+# 2791 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 2862 "parsing/parser.ml"
+# 2856 "parsing/parser.ml"
in
-# 915 "parsing/parser.mly"
+# 919 "parsing/parser.mly"
( xs )
-# 2867 "parsing/parser.ml"
+# 2861 "parsing/parser.ml"
in
-# 3353 "parsing/parser.mly"
+# 3369 "parsing/parser.mly"
( _1 )
-# 2873 "parsing/parser.ml"
+# 2867 "parsing/parser.ml"
in
let _3 =
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 2881 "parsing/parser.ml"
+# 2875 "parsing/parser.ml"
in
-# 947 "parsing/parser.mly"
+# 951 "parsing/parser.mly"
( xs )
-# 2886 "parsing/parser.ml"
+# 2880 "parsing/parser.ml"
in
-# 3325 "parsing/parser.mly"
+# 3341 "parsing/parser.mly"
( _1 )
-# 2892 "parsing/parser.ml"
+# 2886 "parsing/parser.ml"
in
-# 3292 "parsing/parser.mly"
+# 3308 "parsing/parser.mly"
( Ptyp_variant(_3, Closed, Some _5) )
-# 2898 "parsing/parser.ml"
+# 2892 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 854 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2908 "parsing/parser.ml"
+# 2902 "parsing/parser.ml"
in
-# 3296 "parsing/parser.mly"
+# 3312 "parsing/parser.mly"
( _1 )
-# 2914 "parsing/parser.ml"
+# 2908 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3294 "parsing/parser.mly"
+# 3310 "parsing/parser.mly"
( Ptyp_extension _1 )
-# 2940 "parsing/parser.ml"
+# 2934 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 854 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2948 "parsing/parser.ml"
+# 2942 "parsing/parser.ml"
in
-# 3296 "parsing/parser.mly"
+# 3312 "parsing/parser.mly"
( _1 )
-# 2954 "parsing/parser.ml"
+# 2948 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (string Asttypes.loc) = let _1 =
let _1 =
-# 3708 "parsing/parser.mly"
+# 3724 "parsing/parser.mly"
( _1 )
-# 2980 "parsing/parser.ml"
+# 2974 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 843 "parsing/parser.mly"
+# 847 "parsing/parser.mly"
( mkloc _1 (make_loc _sloc) )
-# 2988 "parsing/parser.ml"
+# 2982 "parsing/parser.ml"
in
-# 3710 "parsing/parser.mly"
+# 3726 "parsing/parser.mly"
( _1 )
-# 2994 "parsing/parser.ml"
+# 2988 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (string Asttypes.loc) = let _1 =
let _1 =
-# 3709 "parsing/parser.mly"
+# 3725 "parsing/parser.mly"
( _1 ^ "." ^ _3.txt )
-# 3034 "parsing/parser.ml"
+# 3028 "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
-# 843 "parsing/parser.mly"
+# 847 "parsing/parser.mly"
( mkloc _1 (make_loc _sloc) )
-# 3043 "parsing/parser.ml"
+# 3037 "parsing/parser.ml"
in
-# 3710 "parsing/parser.mly"
+# 3726 "parsing/parser.mly"
( _1 )
-# 3049 "parsing/parser.ml"
+# 3043 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3714 "parsing/parser.mly"
+# 3730 "parsing/parser.mly"
( Attr.mk ~loc:(make_loc _sloc) _2 _3 )
-# 3098 "parsing/parser.ml"
+# 3092 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.class_expr) =
-# 1762 "parsing/parser.mly"
+# 1768 "parsing/parser.mly"
( _1 )
-# 3123 "parsing/parser.ml"
+# 3117 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_expr) = let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 3164 "parsing/parser.ml"
+# 3158 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1764 "parsing/parser.mly"
+# 1770 "parsing/parser.mly"
( wrap_class_attrs ~loc:_sloc _3 _2 )
-# 3173 "parsing/parser.ml"
+# 3167 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1766 "parsing/parser.mly"
+# 1772 "parsing/parser.mly"
( class_of_let_bindings ~loc:_sloc _1 _3 )
-# 3215 "parsing/parser.ml"
+# 3209 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 3280 "parsing/parser.ml"
+# 3274 "parsing/parser.ml"
in
+ let _endpos__5_ = _endpos__1_inlined2_ in
let _4 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 3288 "parsing/parser.ml"
+# 3283 "parsing/parser.ml"
in
- let _endpos__4_ = _endpos__1_inlined1_ in
let _3 =
-# 3633 "parsing/parser.mly"
+# 3649 "parsing/parser.mly"
( Fresh )
-# 3295 "parsing/parser.ml"
+# 3289 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1768 "parsing/parser.mly"
- ( let loc = (_startpos__2_, _endpos__4_) in
+# 1774 "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)) )
-# 3305 "parsing/parser.ml"
+# 3299 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 3377 "parsing/parser.ml"
+# 3371 "parsing/parser.ml"
in
+ let _endpos__5_ = _endpos__1_inlined3_ in
let _4 =
let _1 = _1_inlined2 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 3385 "parsing/parser.ml"
+# 3380 "parsing/parser.ml"
in
- let _endpos__4_ = _endpos__1_inlined2_ in
let _3 =
let _1 = _1_inlined1 in
-# 3634 "parsing/parser.mly"
+# 3650 "parsing/parser.mly"
( Override )
-# 3394 "parsing/parser.ml"
+# 3388 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1768 "parsing/parser.mly"
- ( let loc = (_startpos__2_, _endpos__4_) in
+# 1774 "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)) )
-# 3405 "parsing/parser.ml"
+# 3399 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.class_expr) =
-# 1772 "parsing/parser.mly"
+# 1778 "parsing/parser.mly"
( Cl.attr _1 _2 )
-# 3437 "parsing/parser.ml"
+# 3431 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 3472 "parsing/parser.ml"
+# 3466 "parsing/parser.ml"
in
-# 915 "parsing/parser.mly"
+# 919 "parsing/parser.mly"
( xs )
-# 3477 "parsing/parser.ml"
+# 3471 "parsing/parser.ml"
in
-# 1775 "parsing/parser.mly"
+# 1781 "parsing/parser.mly"
( Pcl_apply(_1, _2) )
-# 3483 "parsing/parser.ml"
+# 3477 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_xs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 866 "parsing/parser.mly"
+# 870 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 3493 "parsing/parser.ml"
+# 3487 "parsing/parser.ml"
in
-# 1778 "parsing/parser.mly"
+# 1784 "parsing/parser.mly"
( _1 )
-# 3499 "parsing/parser.ml"
+# 3493 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.class_expr) = let _1 =
let _1 =
-# 1777 "parsing/parser.mly"
+# 1783 "parsing/parser.mly"
( Pcl_extension _1 )
-# 3525 "parsing/parser.ml"
+# 3519 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 866 "parsing/parser.mly"
+# 870 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 3533 "parsing/parser.ml"
+# 3527 "parsing/parser.ml"
in
-# 1778 "parsing/parser.mly"
+# 1784 "parsing/parser.mly"
( _1 )
-# 3539 "parsing/parser.ml"
+# 3533 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field) = let _6 =
let _1 = _1_inlined2 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 3594 "parsing/parser.ml"
+# 3588 "parsing/parser.ml"
in
let _endpos__6_ = _endpos__1_inlined2_ in
let _3 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 3603 "parsing/parser.ml"
+# 3597 "parsing/parser.ml"
in
let _2 =
-# 3633 "parsing/parser.mly"
+# 3649 "parsing/parser.mly"
( Fresh )
-# 3609 "parsing/parser.ml"
+# 3603 "parsing/parser.ml"
in
let _endpos = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1827 "parsing/parser.mly"
+# 1833 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_inherit (_2, _4, self)) ~attrs:(_3@_6) ~docs )
-# 3618 "parsing/parser.ml"
+# 3612 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field) = let _6 =
let _1 = _1_inlined3 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 3680 "parsing/parser.ml"
+# 3674 "parsing/parser.ml"
in
let _endpos__6_ = _endpos__1_inlined3_ in
let _3 =
let _1 = _1_inlined2 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 3689 "parsing/parser.ml"
+# 3683 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3634 "parsing/parser.mly"
+# 3650 "parsing/parser.mly"
( Override )
-# 3697 "parsing/parser.ml"
+# 3691 "parsing/parser.ml"
in
let _endpos = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1827 "parsing/parser.mly"
+# 1833 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_inherit (_2, _4, self)) ~attrs:(_3@_6) ~docs )
-# 3707 "parsing/parser.ml"
+# 3701 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field) = let _3 =
let _1 = _1_inlined1 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 3750 "parsing/parser.ml"
+# 3744 "parsing/parser.ml"
in
let _endpos__3_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1830 "parsing/parser.mly"
+# 1836 "parsing/parser.mly"
( let v, attrs = _2 in
let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_val v) ~attrs:(attrs@_3) ~docs )
-# 3762 "parsing/parser.ml"
+# 3756 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field) = let _3 =
let _1 = _1_inlined1 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 3805 "parsing/parser.ml"
+# 3799 "parsing/parser.ml"
in
let _endpos__3_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1834 "parsing/parser.mly"
+# 1840 "parsing/parser.mly"
( let meth, attrs = _2 in
let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_method meth) ~attrs:(attrs@_3) ~docs )
-# 3817 "parsing/parser.ml"
+# 3811 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field) = let _4 =
let _1 = _1_inlined2 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 3865 "parsing/parser.ml"
+# 3859 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 3874 "parsing/parser.ml"
+# 3868 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1838 "parsing/parser.mly"
+# 1844 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_constraint _3) ~attrs:(_2@_4) ~docs )
-# 3884 "parsing/parser.ml"
+# 3878 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field) = let _4 =
let _1 = _1_inlined2 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 3932 "parsing/parser.ml"
+# 3926 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 3941 "parsing/parser.ml"
+# 3935 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1841 "parsing/parser.mly"
+# 1847 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_initializer _3) ~attrs:(_2@_4) ~docs )
-# 3951 "parsing/parser.ml"
+# 3945 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field) = let _2 =
let _1 = _1_inlined1 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 3985 "parsing/parser.ml"
+# 3979 "parsing/parser.ml"
in
let _endpos__2_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1844 "parsing/parser.mly"
+# 1850 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_extension _1) ~attrs:_2 ~docs )
-# 3996 "parsing/parser.ml"
+# 3990 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.class_field) = let _1 =
let _1 =
-# 1847 "parsing/parser.mly"
+# 1853 "parsing/parser.mly"
( Pcf_attribute _1 )
-# 4022 "parsing/parser.ml"
+# 4016 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 864 "parsing/parser.mly"
+# 868 "parsing/parser.mly"
( mkcf ~loc:_sloc _1 )
-# 4030 "parsing/parser.ml"
+# 4024 "parsing/parser.ml"
in
-# 1848 "parsing/parser.mly"
+# 1854 "parsing/parser.mly"
( _1 )
-# 4036 "parsing/parser.ml"
+# 4030 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.class_expr) =
-# 1742 "parsing/parser.mly"
+# 1748 "parsing/parser.mly"
( _2 )
-# 4068 "parsing/parser.ml"
+# 4062 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__4_ in
let _v : (Parsetree.class_expr) = let _1 =
let _1 =
-# 1745 "parsing/parser.mly"
+# 1751 "parsing/parser.mly"
( Pcl_constraint(_4, _2) )
-# 4115 "parsing/parser.ml"
+# 4109 "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
-# 866 "parsing/parser.mly"
+# 870 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 4124 "parsing/parser.ml"
+# 4118 "parsing/parser.ml"
in
-# 1748 "parsing/parser.mly"
+# 1754 "parsing/parser.mly"
( _1 )
-# 4130 "parsing/parser.ml"
+# 4124 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Parsetree.class_expr) = let _1 =
let _1 =
-# 1747 "parsing/parser.mly"
+# 1753 "parsing/parser.mly"
( let (l,o,p) = _1 in Pcl_fun(l, o, p, _2) )
-# 4163 "parsing/parser.ml"
+# 4157 "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
-# 866 "parsing/parser.mly"
+# 870 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 4172 "parsing/parser.ml"
+# 4166 "parsing/parser.ml"
in
-# 1748 "parsing/parser.mly"
+# 1754 "parsing/parser.mly"
( _1 )
-# 4178 "parsing/parser.ml"
+# 4172 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_e_ in
let _v : (Parsetree.class_expr) = let _1 =
let _1 =
-# 1803 "parsing/parser.mly"
+# 1809 "parsing/parser.mly"
( let (l,o,p) = _1 in Pcl_fun(l, o, p, e) )
-# 4218 "parsing/parser.ml"
+# 4212 "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
-# 866 "parsing/parser.mly"
+# 870 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 4227 "parsing/parser.ml"
+# 4221 "parsing/parser.ml"
in
-# 1804 "parsing/parser.mly"
+# 1810 "parsing/parser.mly"
( _1 )
-# 4233 "parsing/parser.ml"
+# 4227 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_e_ in
let _v : (Parsetree.class_expr) = let _1 =
let _1 =
-# 1803 "parsing/parser.mly"
+# 1809 "parsing/parser.mly"
( let (l,o,p) = _1 in Pcl_fun(l, o, p, e) )
-# 4266 "parsing/parser.ml"
+# 4260 "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
-# 866 "parsing/parser.mly"
+# 870 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 4275 "parsing/parser.ml"
+# 4269 "parsing/parser.ml"
in
-# 1804 "parsing/parser.mly"
+# 1810 "parsing/parser.mly"
( _1 )
-# 4281 "parsing/parser.ml"
+# 4275 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3519 "parsing/parser.mly"
+# 3535 "parsing/parser.mly"
( _1 )
-# 4306 "parsing/parser.ml"
+# 4300 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1812 "parsing/parser.mly"
+# 1818 "parsing/parser.mly"
( reloc_pat ~loc:_sloc _2 )
-# 4348 "parsing/parser.ml"
+# 4342 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__5_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 1814 "parsing/parser.mly"
+# 1820 "parsing/parser.mly"
( Ppat_constraint(_2, _4) )
-# 4402 "parsing/parser.ml"
+# 4396 "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
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 4411 "parsing/parser.ml"
+# 4405 "parsing/parser.ml"
in
-# 1815 "parsing/parser.mly"
+# 1821 "parsing/parser.mly"
( _1 )
-# 4417 "parsing/parser.ml"
+# 4411 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _endpos in
let _sloc = (_symbolstartpos, _endpos) in
-# 1817 "parsing/parser.mly"
+# 1823 "parsing/parser.mly"
( ghpat ~loc:_sloc Ppat_any )
-# 4438 "parsing/parser.ml"
+# 4432 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.core_type) =
-# 1942 "parsing/parser.mly"
+# 1948 "parsing/parser.mly"
( _2 )
-# 4477 "parsing/parser.ml"
+# 4471 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _startpos in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 1943 "parsing/parser.mly"
+# 1949 "parsing/parser.mly"
( Ptyp_any )
-# 4496 "parsing/parser.ml"
+# 4490 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__0_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _endpos in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 854 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 4505 "parsing/parser.ml"
+# 4499 "parsing/parser.ml"
in
-# 1944 "parsing/parser.mly"
+# 1950 "parsing/parser.mly"
( _1 )
-# 4511 "parsing/parser.ml"
+# 4505 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_type_field) = let _4 =
let _1 = _1_inlined2 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 4559 "parsing/parser.ml"
+# 4553 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 4568 "parsing/parser.ml"
+# 4562 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1952 "parsing/parser.mly"
+# 1958 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkctf ~loc:_sloc (Pctf_inherit _3) ~attrs:(_2@_4) ~docs )
-# 4578 "parsing/parser.ml"
+# 4572 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let ty : (Parsetree.core_type) = Obj.magic ty in
let _3 : unit = Obj.magic _3 in
let _1_inlined2 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 4638 "parsing/parser.ml"
+# 4632 "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
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 4651 "parsing/parser.ml"
+# 4645 "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 =
-# 3393 "parsing/parser.mly"
+# 3409 "parsing/parser.mly"
( _1 )
-# 4661 "parsing/parser.ml"
+# 4655 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 4669 "parsing/parser.ml"
+# 4663 "parsing/parser.ml"
in
-# 1977 "parsing/parser.mly"
+# 1983 "parsing/parser.mly"
(
let mut, virt = flags in
label, mut, virt, ty
)
-# 4678 "parsing/parser.ml"
+# 4672 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 4686 "parsing/parser.ml"
+# 4680 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1955 "parsing/parser.mly"
+# 1961 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkctf ~loc:_sloc (Pctf_val _3) ~attrs:(_2@_4) ~docs )
-# 4696 "parsing/parser.ml"
+# 4690 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined3 : (Parsetree.core_type) = Obj.magic _1_inlined3 in
let _5 : unit = Obj.magic _5 in
let _1_inlined2 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 4756 "parsing/parser.ml"
+# 4750 "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
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 4769 "parsing/parser.ml"
+# 4763 "parsing/parser.ml"
in
let _endpos__7_ = _endpos__1_inlined4_ in
let _6 =
let _1 = _1_inlined3 in
-# 3164 "parsing/parser.mly"
+# 3180 "parsing/parser.mly"
( _1 )
-# 4778 "parsing/parser.ml"
+# 4772 "parsing/parser.ml"
in
let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _1 =
-# 3393 "parsing/parser.mly"
+# 3409 "parsing/parser.mly"
( _1 )
-# 4786 "parsing/parser.ml"
+# 4780 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 4794 "parsing/parser.ml"
+# 4788 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 4802 "parsing/parser.ml"
+# 4796 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1959 "parsing/parser.mly"
+# 1965 "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 )
-# 4813 "parsing/parser.ml"
+# 4807 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_type_field) = let _4 =
let _1 = _1_inlined2 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 4861 "parsing/parser.ml"
+# 4855 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 4870 "parsing/parser.ml"
+# 4864 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1963 "parsing/parser.mly"
+# 1969 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkctf ~loc:_sloc (Pctf_constraint _3) ~attrs:(_2@_4) ~docs )
-# 4880 "parsing/parser.ml"
+# 4874 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_type_field) = let _2 =
let _1 = _1_inlined1 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 4914 "parsing/parser.ml"
+# 4908 "parsing/parser.ml"
in
let _endpos__2_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1966 "parsing/parser.mly"
+# 1972 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkctf ~loc:_sloc (Pctf_extension _1) ~attrs:_2 ~docs )
-# 4925 "parsing/parser.ml"
+# 4919 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.class_type_field) = let _1 =
let _1 =
-# 1969 "parsing/parser.mly"
+# 1975 "parsing/parser.mly"
( Pctf_attribute _1 )
-# 4951 "parsing/parser.ml"
+# 4945 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 862 "parsing/parser.mly"
+# 866 "parsing/parser.mly"
( mkctf ~loc:_sloc _1 )
-# 4959 "parsing/parser.ml"
+# 4953 "parsing/parser.ml"
in
-# 1970 "parsing/parser.mly"
+# 1976 "parsing/parser.mly"
( _1 )
-# 4965 "parsing/parser.ml"
+# 4959 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 4996 "parsing/parser.ml"
+# 4990 "parsing/parser.ml"
in
let tys =
let tys =
-# 1928 "parsing/parser.mly"
+# 1934 "parsing/parser.mly"
( [] )
-# 5003 "parsing/parser.ml"
+# 4997 "parsing/parser.ml"
in
-# 1934 "parsing/parser.mly"
+# 1940 "parsing/parser.mly"
( tys )
-# 5008 "parsing/parser.ml"
+# 5002 "parsing/parser.ml"
in
-# 1911 "parsing/parser.mly"
+# 1917 "parsing/parser.mly"
( Pcty_constr (cid, tys) )
-# 5014 "parsing/parser.ml"
+# 5008 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 860 "parsing/parser.mly"
+# 864 "parsing/parser.mly"
( mkcty ~loc:_sloc _1 )
-# 5023 "parsing/parser.ml"
+# 5017 "parsing/parser.ml"
in
-# 1914 "parsing/parser.mly"
+# 1920 "parsing/parser.mly"
( _1 )
-# 5029 "parsing/parser.ml"
+# 5023 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 5082 "parsing/parser.ml"
+# 5076 "parsing/parser.ml"
in
let tys =
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 5091 "parsing/parser.ml"
+# 5085 "parsing/parser.ml"
in
-# 947 "parsing/parser.mly"
+# 951 "parsing/parser.mly"
( xs )
-# 5096 "parsing/parser.ml"
+# 5090 "parsing/parser.ml"
in
-# 1930 "parsing/parser.mly"
+# 1936 "parsing/parser.mly"
( params )
-# 5102 "parsing/parser.ml"
+# 5096 "parsing/parser.ml"
in
-# 1934 "parsing/parser.mly"
+# 1940 "parsing/parser.mly"
( tys )
-# 5108 "parsing/parser.ml"
+# 5102 "parsing/parser.ml"
in
-# 1911 "parsing/parser.mly"
+# 1917 "parsing/parser.mly"
( Pcty_constr (cid, tys) )
-# 5114 "parsing/parser.ml"
+# 5108 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 860 "parsing/parser.mly"
+# 864 "parsing/parser.mly"
( mkcty ~loc:_sloc _1 )
-# 5124 "parsing/parser.ml"
+# 5118 "parsing/parser.ml"
in
-# 1914 "parsing/parser.mly"
+# 1920 "parsing/parser.mly"
( _1 )
-# 5130 "parsing/parser.ml"
+# 5124 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.class_type) = let _1 =
let _1 =
-# 1913 "parsing/parser.mly"
+# 1919 "parsing/parser.mly"
( Pcty_extension _1 )
-# 5156 "parsing/parser.ml"
+# 5150 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 860 "parsing/parser.mly"
+# 864 "parsing/parser.mly"
( mkcty ~loc:_sloc _1 )
-# 5164 "parsing/parser.ml"
+# 5158 "parsing/parser.ml"
in
-# 1914 "parsing/parser.mly"
+# 1920 "parsing/parser.mly"
( _1 )
-# 5170 "parsing/parser.ml"
+# 5164 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
# 260 "<standard.mly>"
( List.flatten xss )
-# 5227 "parsing/parser.ml"
+# 5221 "parsing/parser.ml"
in
-# 1948 "parsing/parser.mly"
+# 1954 "parsing/parser.mly"
( _1 )
-# 5232 "parsing/parser.ml"
+# 5226 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 808 "parsing/parser.mly"
+# 812 "parsing/parser.mly"
( extra_csig _startpos _endpos _1 )
-# 5241 "parsing/parser.ml"
+# 5235 "parsing/parser.ml"
in
-# 1938 "parsing/parser.mly"
+# 1944 "parsing/parser.mly"
( Csig.mk _1 _2 )
-# 5247 "parsing/parser.ml"
+# 5241 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 5255 "parsing/parser.ml"
+# 5249 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1916 "parsing/parser.mly"
+# 1922 "parsing/parser.mly"
( mkcty ~loc:_sloc ~attrs:_2 (Pcty_signature _3) )
-# 5264 "parsing/parser.ml"
+# 5258 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
# 260 "<standard.mly>"
( List.flatten xss )
-# 5321 "parsing/parser.ml"
+# 5315 "parsing/parser.ml"
in
-# 1948 "parsing/parser.mly"
+# 1954 "parsing/parser.mly"
( _1 )
-# 5326 "parsing/parser.ml"
+# 5320 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 808 "parsing/parser.mly"
+# 812 "parsing/parser.mly"
( extra_csig _startpos _endpos _1 )
-# 5335 "parsing/parser.ml"
+# 5329 "parsing/parser.ml"
in
-# 1938 "parsing/parser.mly"
+# 1944 "parsing/parser.mly"
( Csig.mk _1 _2 )
-# 5341 "parsing/parser.ml"
+# 5335 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 5349 "parsing/parser.ml"
+# 5343 "parsing/parser.ml"
in
let _loc__4_ = (_startpos__4_, _endpos__4_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1918 "parsing/parser.mly"
+# 1924 "parsing/parser.mly"
( unclosed "object" _loc__1_ "end" _loc__4_ )
-# 5357 "parsing/parser.ml"
+# 5351 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.class_type) =
-# 1920 "parsing/parser.mly"
+# 1926 "parsing/parser.mly"
( Cty.attr _1 _2 )
-# 5389 "parsing/parser.ml"
+# 5383 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 5454 "parsing/parser.ml"
+# 5448 "parsing/parser.ml"
in
+ let _endpos__5_ = _endpos__1_inlined2_ in
let _4 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 5462 "parsing/parser.ml"
+# 5457 "parsing/parser.ml"
in
- let _endpos__4_ = _endpos__1_inlined1_ in
let _3 =
-# 3633 "parsing/parser.mly"
+# 3649 "parsing/parser.mly"
( Fresh )
-# 5469 "parsing/parser.ml"
+# 5463 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1922 "parsing/parser.mly"
- ( let loc = (_startpos__2_, _endpos__4_) in
+# 1928 "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)) )
-# 5479 "parsing/parser.ml"
+# 5473 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 5551 "parsing/parser.ml"
+# 5545 "parsing/parser.ml"
in
+ let _endpos__5_ = _endpos__1_inlined3_ in
let _4 =
let _1 = _1_inlined2 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 5559 "parsing/parser.ml"
+# 5554 "parsing/parser.ml"
in
- let _endpos__4_ = _endpos__1_inlined2_ in
let _3 =
let _1 = _1_inlined1 in
-# 3634 "parsing/parser.mly"
+# 3650 "parsing/parser.mly"
( Override )
-# 5568 "parsing/parser.ml"
+# 5562 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1922 "parsing/parser.mly"
- ( let loc = (_startpos__2_, _endpos__4_) in
+# 1928 "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)) )
-# 5579 "parsing/parser.ml"
+# 5573 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.class_expr) =
-# 1782 "parsing/parser.mly"
+# 1788 "parsing/parser.mly"
( _2 )
-# 5618 "parsing/parser.ml"
+# 5612 "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
-# 1784 "parsing/parser.mly"
+# 1790 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__3_ )
-# 5659 "parsing/parser.ml"
+# 5653 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 5690 "parsing/parser.ml"
+# 5684 "parsing/parser.ml"
in
let tys =
let tys =
-# 1928 "parsing/parser.mly"
+# 1934 "parsing/parser.mly"
( [] )
-# 5697 "parsing/parser.ml"
+# 5691 "parsing/parser.ml"
in
-# 1934 "parsing/parser.mly"
+# 1940 "parsing/parser.mly"
( tys )
-# 5702 "parsing/parser.ml"
+# 5696 "parsing/parser.ml"
in
-# 1787 "parsing/parser.mly"
+# 1793 "parsing/parser.mly"
( Pcl_constr(cid, tys) )
-# 5708 "parsing/parser.ml"
+# 5702 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 866 "parsing/parser.mly"
+# 870 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 5717 "parsing/parser.ml"
+# 5711 "parsing/parser.ml"
in
-# 1794 "parsing/parser.mly"
+# 1800 "parsing/parser.mly"
( _1 )
-# 5723 "parsing/parser.ml"
+# 5717 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 5776 "parsing/parser.ml"
+# 5770 "parsing/parser.ml"
in
let tys =
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 5785 "parsing/parser.ml"
+# 5779 "parsing/parser.ml"
in
-# 947 "parsing/parser.mly"
+# 951 "parsing/parser.mly"
( xs )
-# 5790 "parsing/parser.ml"
+# 5784 "parsing/parser.ml"
in
-# 1930 "parsing/parser.mly"
+# 1936 "parsing/parser.mly"
( params )
-# 5796 "parsing/parser.ml"
+# 5790 "parsing/parser.ml"
in
-# 1934 "parsing/parser.mly"
+# 1940 "parsing/parser.mly"
( tys )
-# 5802 "parsing/parser.ml"
+# 5796 "parsing/parser.ml"
in
-# 1787 "parsing/parser.mly"
+# 1793 "parsing/parser.mly"
( Pcl_constr(cid, tys) )
-# 5808 "parsing/parser.ml"
+# 5802 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 866 "parsing/parser.mly"
+# 870 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 5818 "parsing/parser.ml"
+# 5812 "parsing/parser.ml"
in
-# 1794 "parsing/parser.mly"
+# 1800 "parsing/parser.mly"
( _1 )
-# 5824 "parsing/parser.ml"
+# 5818 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
# 260 "<standard.mly>"
( List.flatten xss )
-# 5883 "parsing/parser.ml"
+# 5877 "parsing/parser.ml"
in
-# 1821 "parsing/parser.mly"
+# 1827 "parsing/parser.mly"
( _1 )
-# 5888 "parsing/parser.ml"
+# 5882 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 807 "parsing/parser.mly"
+# 811 "parsing/parser.mly"
( extra_cstr _startpos _endpos _1 )
-# 5897 "parsing/parser.ml"
+# 5891 "parsing/parser.ml"
in
-# 1808 "parsing/parser.mly"
+# 1814 "parsing/parser.mly"
( Cstr.mk _1 _2 )
-# 5903 "parsing/parser.ml"
+# 5897 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 5911 "parsing/parser.ml"
+# 5905 "parsing/parser.ml"
in
let _loc__4_ = (_startpos__4_, _endpos__4_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1789 "parsing/parser.mly"
+# 1795 "parsing/parser.mly"
( unclosed "object" _loc__1_ "end" _loc__4_ )
-# 5919 "parsing/parser.ml"
+# 5913 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 866 "parsing/parser.mly"
+# 870 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 5929 "parsing/parser.ml"
+# 5923 "parsing/parser.ml"
in
-# 1794 "parsing/parser.mly"
+# 1800 "parsing/parser.mly"
( _1 )
-# 5935 "parsing/parser.ml"
+# 5929 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__5_ in
let _v : (Parsetree.class_expr) = let _1 =
let _1 =
-# 1791 "parsing/parser.mly"
+# 1797 "parsing/parser.mly"
( Pcl_constraint(_2, _4) )
-# 5989 "parsing/parser.ml"
+# 5983 "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
-# 866 "parsing/parser.mly"
+# 870 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 5998 "parsing/parser.ml"
+# 5992 "parsing/parser.ml"
in
-# 1794 "parsing/parser.mly"
+# 1800 "parsing/parser.mly"
( _1 )
-# 6004 "parsing/parser.ml"
+# 5998 "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
-# 1793 "parsing/parser.mly"
+# 1799 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__5_ )
-# 6061 "parsing/parser.ml"
+# 6055 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 866 "parsing/parser.mly"
+# 870 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 6071 "parsing/parser.ml"
+# 6065 "parsing/parser.ml"
in
-# 1794 "parsing/parser.mly"
+# 1800 "parsing/parser.mly"
( _1 )
-# 6077 "parsing/parser.ml"
+# 6071 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
# 260 "<standard.mly>"
( List.flatten xss )
-# 6134 "parsing/parser.ml"
+# 6128 "parsing/parser.ml"
in
-# 1821 "parsing/parser.mly"
+# 1827 "parsing/parser.mly"
( _1 )
-# 6139 "parsing/parser.ml"
+# 6133 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 807 "parsing/parser.mly"
+# 811 "parsing/parser.mly"
( extra_cstr _startpos _endpos _1 )
-# 6148 "parsing/parser.ml"
+# 6142 "parsing/parser.ml"
in
-# 1808 "parsing/parser.mly"
+# 1814 "parsing/parser.mly"
( Cstr.mk _1 _2 )
-# 6154 "parsing/parser.ml"
+# 6148 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 6162 "parsing/parser.ml"
+# 6156 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1796 "parsing/parser.mly"
+# 1802 "parsing/parser.mly"
( mkclass ~loc:_sloc ~attrs:_2 (Pcl_structure _3) )
-# 6171 "parsing/parser.ml"
+# 6165 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.class_type) =
-# 1899 "parsing/parser.mly"
+# 1905 "parsing/parser.mly"
( _1 )
-# 6196 "parsing/parser.ml"
+# 6190 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_type) = let _1 =
let _1 =
let label =
-# 3227 "parsing/parser.mly"
+# 3243 "parsing/parser.mly"
( Optional label )
-# 6244 "parsing/parser.ml"
+# 6238 "parsing/parser.ml"
in
-# 1905 "parsing/parser.mly"
+# 1911 "parsing/parser.mly"
( Pcty_arrow(label, domain, codomain) )
-# 6249 "parsing/parser.ml"
+# 6243 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 860 "parsing/parser.mly"
+# 864 "parsing/parser.mly"
( mkcty ~loc:_sloc _1 )
-# 6259 "parsing/parser.ml"
+# 6253 "parsing/parser.ml"
in
-# 1906 "parsing/parser.mly"
+# 1912 "parsing/parser.mly"
( _1 )
-# 6265 "parsing/parser.ml"
+# 6259 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let domain : (Parsetree.core_type) = Obj.magic domain in
let _2 : unit = Obj.magic _2 in
let label : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 6314 "parsing/parser.ml"
+# 6308 "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 =
-# 3229 "parsing/parser.mly"
+# 3245 "parsing/parser.mly"
( Labelled label )
-# 6324 "parsing/parser.ml"
+# 6318 "parsing/parser.ml"
in
-# 1905 "parsing/parser.mly"
+# 1911 "parsing/parser.mly"
( Pcty_arrow(label, domain, codomain) )
-# 6329 "parsing/parser.ml"
+# 6323 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 860 "parsing/parser.mly"
+# 864 "parsing/parser.mly"
( mkcty ~loc:_sloc _1 )
-# 6339 "parsing/parser.ml"
+# 6333 "parsing/parser.ml"
in
-# 1906 "parsing/parser.mly"
+# 1912 "parsing/parser.mly"
( _1 )
-# 6345 "parsing/parser.ml"
+# 6339 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_type) = let _1 =
let _1 =
let label =
-# 3231 "parsing/parser.mly"
+# 3247 "parsing/parser.mly"
( Nolabel )
-# 6386 "parsing/parser.ml"
+# 6380 "parsing/parser.ml"
in
-# 1905 "parsing/parser.mly"
+# 1911 "parsing/parser.mly"
( Pcty_arrow(label, domain, codomain) )
-# 6391 "parsing/parser.ml"
+# 6385 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_domain_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 860 "parsing/parser.mly"
+# 864 "parsing/parser.mly"
( mkcty ~loc:_sloc _1 )
-# 6401 "parsing/parser.ml"
+# 6395 "parsing/parser.ml"
in
-# 1906 "parsing/parser.mly"
+# 1912 "parsing/parser.mly"
( _1 )
-# 6407 "parsing/parser.ml"
+# 6401 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let csig : (Parsetree.class_type) = Obj.magic csig in
let _8 : unit = Obj.magic _8 in
let _1_inlined2 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 6492 "parsing/parser.ml"
+# 6486 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
- let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params 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 _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let ext : (string Asttypes.loc option) = Obj.magic ext in
let attrs2 =
let _1 = _1_inlined3 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 6510 "parsing/parser.ml"
+# 6504 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 6522 "parsing/parser.ml"
+# 6516 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 6530 "parsing/parser.ml"
+# 6524 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2044 "parsing/parser.mly"
+# 2050 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
ext,
Ci.mk id csig ~virt ~params ~attrs ~loc ~docs
)
-# 6545 "parsing/parser.ml"
+# 6539 "parsing/parser.ml"
in
-# 1044 "parsing/parser.mly"
+# 1048 "parsing/parser.mly"
( let (x, b) = a in x, b :: bs )
-# 6551 "parsing/parser.ml"
+# 6545 "parsing/parser.ml"
in
-# 2032 "parsing/parser.mly"
+# 2038 "parsing/parser.mly"
( _1 )
-# 6557 "parsing/parser.ml"
+# 6551 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3516 "parsing/parser.mly"
+# 3532 "parsing/parser.mly"
( _1 )
-# 6582 "parsing/parser.ml"
+# 6576 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 633 "parsing/parser.mly"
+# 637 "parsing/parser.mly"
(string * char option)
-# 6603 "parsing/parser.ml"
+# 6597 "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) =
-# 3399 "parsing/parser.mly"
+# 3415 "parsing/parser.mly"
( let (n, m) = _1 in Pconst_integer (n, m) )
-# 6611 "parsing/parser.ml"
+# 6605 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 592 "parsing/parser.mly"
+# 596 "parsing/parser.mly"
(char)
-# 6632 "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) =
-# 3400 "parsing/parser.mly"
+# 3416 "parsing/parser.mly"
( Pconst_char _1 )
-# 6640 "parsing/parser.ml"
+# 6634 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 685 "parsing/parser.mly"
+# 689 "parsing/parser.mly"
(string * Location.t * string option)
-# 6661 "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) =
-# 3401 "parsing/parser.mly"
+# 3417 "parsing/parser.mly"
( let (s, strloc, d) = _1 in Pconst_string (s, strloc, d) )
-# 6669 "parsing/parser.ml"
+# 6663 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 612 "parsing/parser.mly"
+# 616 "parsing/parser.mly"
(string * char option)
-# 6690 "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) =
-# 3402 "parsing/parser.mly"
+# 3418 "parsing/parser.mly"
( let (f, m) = _1 in Pconst_float (f, m) )
-# 6698 "parsing/parser.ml"
+# 6692 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.label) =
-# 3473 "parsing/parser.mly"
+# 3489 "parsing/parser.mly"
( "[]" )
-# 6730 "parsing/parser.ml"
+# 6724 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.label) =
-# 3474 "parsing/parser.mly"
+# 3490 "parsing/parser.mly"
( "()" )
-# 6762 "parsing/parser.ml"
+# 6756 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) =
-# 3475 "parsing/parser.mly"
+# 3491 "parsing/parser.mly"
( "false" )
-# 6787 "parsing/parser.ml"
+# 6781 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) =
-# 3476 "parsing/parser.mly"
+# 3492 "parsing/parser.mly"
( "true" )
-# 6812 "parsing/parser.ml"
+# 6806 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 697 "parsing/parser.mly"
+# 701 "parsing/parser.mly"
(string)
-# 6833 "parsing/parser.ml"
+# 6827 "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) =
-# 3479 "parsing/parser.mly"
+# 3495 "parsing/parser.mly"
( _1 )
-# 6841 "parsing/parser.ml"
+# 6835 "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 =
-# 3470 "parsing/parser.mly"
+# 3486 "parsing/parser.mly"
( "::" )
-# 6880 "parsing/parser.ml"
+# 6874 "parsing/parser.ml"
in
-# 3480 "parsing/parser.mly"
+# 3496 "parsing/parser.mly"
( _1 )
-# 6885 "parsing/parser.ml"
+# 6879 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) =
-# 3481 "parsing/parser.mly"
+# 3497 "parsing/parser.mly"
( _1 )
-# 6910 "parsing/parser.ml"
+# 6904 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3484 "parsing/parser.mly"
+# 3500 "parsing/parser.mly"
( _1 )
-# 6935 "parsing/parser.ml"
+# 6929 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Longident.t) = let _3 =
let (_2, _1) = (_2_inlined1, _1_inlined1) in
-# 3470 "parsing/parser.mly"
+# 3486 "parsing/parser.mly"
( "::" )
-# 6990 "parsing/parser.ml"
+# 6984 "parsing/parser.ml"
in
-# 3485 "parsing/parser.mly"
+# 3501 "parsing/parser.mly"
( Ldot(_1,_3) )
-# 6996 "parsing/parser.ml"
+# 6990 "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 =
-# 3470 "parsing/parser.mly"
+# 3486 "parsing/parser.mly"
( "::" )
-# 7035 "parsing/parser.ml"
+# 7029 "parsing/parser.ml"
in
-# 3486 "parsing/parser.mly"
+# 3502 "parsing/parser.mly"
( Lident _1 )
-# 7040 "parsing/parser.ml"
+# 7034 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3487 "parsing/parser.mly"
+# 3503 "parsing/parser.mly"
( Lident _1 )
-# 7065 "parsing/parser.ml"
+# 7059 "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) =
-# 1988 "parsing/parser.mly"
+# 1994 "parsing/parser.mly"
( _1, _3 )
-# 7104 "parsing/parser.ml"
+# 7098 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.constructor_arguments) = let tys =
let xs =
let xs =
-# 931 "parsing/parser.mly"
+# 935 "parsing/parser.mly"
( [ x ] )
-# 7131 "parsing/parser.ml"
+# 7125 "parsing/parser.ml"
in
# 253 "<standard.mly>"
( List.rev xs )
-# 7136 "parsing/parser.ml"
+# 7130 "parsing/parser.ml"
in
-# 951 "parsing/parser.mly"
+# 955 "parsing/parser.mly"
( xs )
-# 7142 "parsing/parser.ml"
+# 7136 "parsing/parser.ml"
in
-# 3034 "parsing/parser.mly"
+# 3050 "parsing/parser.mly"
( Pcstr_tuple tys )
-# 7148 "parsing/parser.ml"
+# 7142 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.constructor_arguments) = let tys =
let xs =
let xs =
-# 935 "parsing/parser.mly"
+# 939 "parsing/parser.mly"
( x :: xs )
-# 7189 "parsing/parser.ml"
+# 7183 "parsing/parser.ml"
in
# 253 "<standard.mly>"
( List.rev xs )
-# 7194 "parsing/parser.ml"
+# 7188 "parsing/parser.ml"
in
-# 951 "parsing/parser.mly"
+# 955 "parsing/parser.mly"
( xs )
-# 7200 "parsing/parser.ml"
+# 7194 "parsing/parser.ml"
in
-# 3034 "parsing/parser.mly"
+# 3050 "parsing/parser.mly"
( Pcstr_tuple tys )
-# 7206 "parsing/parser.ml"
+# 7200 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.constructor_arguments) =
-# 3036 "parsing/parser.mly"
+# 3052 "parsing/parser.mly"
( Pcstr_record _2 )
-# 7245 "parsing/parser.ml"
+# 7239 "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) =
-# 2955 "parsing/parser.mly"
+# 2971 "parsing/parser.mly"
( [] )
-# 7270 "parsing/parser.ml"
+# 7264 "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 =
-# 1036 "parsing/parser.mly"
+# 1040 "parsing/parser.mly"
( List.rev xs )
-# 7295 "parsing/parser.ml"
+# 7289 "parsing/parser.ml"
in
-# 2957 "parsing/parser.mly"
+# 2973 "parsing/parser.mly"
( cs )
-# 7300 "parsing/parser.ml"
+# 7294 "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 =
-# 3189 "parsing/parser.mly"
+# 3205 "parsing/parser.mly"
( _1 )
-# 7325 "parsing/parser.ml"
+# 7319 "parsing/parser.ml"
in
-# 3179 "parsing/parser.mly"
+# 3195 "parsing/parser.mly"
( _1 )
-# 7330 "parsing/parser.ml"
+# 7324 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type) =
-# 3181 "parsing/parser.mly"
+# 3197 "parsing/parser.mly"
( Typ.attr _1 _2 )
-# 7362 "parsing/parser.ml"
+# 7356 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.direction_flag) =
-# 3578 "parsing/parser.mly"
+# 3594 "parsing/parser.mly"
( Upto )
-# 7387 "parsing/parser.ml"
+# 7381 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.direction_flag) =
-# 3579 "parsing/parser.mly"
+# 3595 "parsing/parser.mly"
( Downto )
-# 7412 "parsing/parser.ml"
+# 7406 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression) =
-# 2135 "parsing/parser.mly"
+# 2141 "parsing/parser.mly"
( _1 )
-# 7437 "parsing/parser.ml"
+# 7431 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 7517 "parsing/parser.ml"
+# 7511 "parsing/parser.ml"
in
let _3 =
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 7527 "parsing/parser.ml"
+# 7521 "parsing/parser.ml"
in
-# 3742 "parsing/parser.mly"
+# 3758 "parsing/parser.mly"
( _1, _2 )
-# 7533 "parsing/parser.ml"
+# 7527 "parsing/parser.ml"
in
-# 2183 "parsing/parser.mly"
+# 2189 "parsing/parser.mly"
( Pexp_letmodule(_4, _5, _7), _3 )
-# 7539 "parsing/parser.ml"
+# 7533 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2137 "parsing/parser.mly"
+# 2143 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 7550 "parsing/parser.ml"
+# 7544 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 7636 "parsing/parser.ml"
+# 7630 "parsing/parser.ml"
in
let _endpos__3_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 7647 "parsing/parser.ml"
+# 7641 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3019 "parsing/parser.mly"
+# 3035 "parsing/parser.mly"
( let args, res = _2 in
Te.decl _1 ~args ?res ~attrs:_3 ~loc:(make_loc _sloc) )
-# 7657 "parsing/parser.ml"
+# 7651 "parsing/parser.ml"
in
let _3 =
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 7667 "parsing/parser.ml"
+# 7661 "parsing/parser.ml"
in
-# 3742 "parsing/parser.mly"
+# 3758 "parsing/parser.mly"
( _1, _2 )
-# 7673 "parsing/parser.ml"
+# 7667 "parsing/parser.ml"
in
-# 2185 "parsing/parser.mly"
+# 2191 "parsing/parser.mly"
( Pexp_letexception(_4, _6), _3 )
-# 7679 "parsing/parser.ml"
+# 7673 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2137 "parsing/parser.mly"
+# 2143 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 7690 "parsing/parser.ml"
+# 7684 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 7762 "parsing/parser.ml"
+# 7756 "parsing/parser.ml"
in
-# 3742 "parsing/parser.mly"
+# 3758 "parsing/parser.mly"
( _1, _2 )
-# 7768 "parsing/parser.ml"
+# 7762 "parsing/parser.ml"
in
let _3 =
-# 3633 "parsing/parser.mly"
+# 3649 "parsing/parser.mly"
( Fresh )
-# 7774 "parsing/parser.ml"
+# 7768 "parsing/parser.ml"
in
-# 2187 "parsing/parser.mly"
+# 2193 "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 )
-# 7781 "parsing/parser.ml"
+# 7775 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2137 "parsing/parser.mly"
+# 2143 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 7792 "parsing/parser.ml"
+# 7786 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 7871 "parsing/parser.ml"
+# 7865 "parsing/parser.ml"
in
-# 3742 "parsing/parser.mly"
+# 3758 "parsing/parser.mly"
( _1, _2 )
-# 7877 "parsing/parser.ml"
+# 7871 "parsing/parser.ml"
in
let _3 =
let _1 = _1_inlined1 in
-# 3634 "parsing/parser.mly"
+# 3650 "parsing/parser.mly"
( Override )
-# 7885 "parsing/parser.ml"
+# 7879 "parsing/parser.ml"
in
-# 2187 "parsing/parser.mly"
+# 2193 "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 )
-# 7893 "parsing/parser.ml"
+# 7887 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2137 "parsing/parser.mly"
+# 2143 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 7904 "parsing/parser.ml"
+# 7898 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 7953 "parsing/parser.ml"
+# 7947 "parsing/parser.ml"
in
-# 1008 "parsing/parser.mly"
+# 1012 "parsing/parser.mly"
( xs )
-# 7958 "parsing/parser.ml"
+# 7952 "parsing/parser.ml"
in
-# 2519 "parsing/parser.mly"
+# 2521 "parsing/parser.mly"
( xs )
-# 7964 "parsing/parser.ml"
+# 7958 "parsing/parser.ml"
in
let _2 =
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 7974 "parsing/parser.ml"
+# 7968 "parsing/parser.ml"
in
-# 3742 "parsing/parser.mly"
+# 3758 "parsing/parser.mly"
( _1, _2 )
-# 7980 "parsing/parser.ml"
+# 7974 "parsing/parser.ml"
in
-# 2191 "parsing/parser.mly"
+# 2197 "parsing/parser.mly"
( Pexp_function _3, _2 )
-# 7986 "parsing/parser.ml"
+# 7980 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_xs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2137 "parsing/parser.mly"
+# 2143 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 7997 "parsing/parser.ml"
+# 7991 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 8055 "parsing/parser.ml"
+# 8049 "parsing/parser.ml"
in
-# 3742 "parsing/parser.mly"
+# 3758 "parsing/parser.mly"
( _1, _2 )
-# 8061 "parsing/parser.ml"
+# 8055 "parsing/parser.ml"
in
-# 2193 "parsing/parser.mly"
+# 2199 "parsing/parser.mly"
( let (l,o,p) = _3 in
Pexp_fun(l, o, p, _4), _2 )
-# 8068 "parsing/parser.ml"
+# 8062 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2137 "parsing/parser.mly"
+# 2143 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8079 "parsing/parser.ml"
+# 8073 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__7_ in
let _v : (Parsetree.expression) = let _1 =
let _5 =
-# 2414 "parsing/parser.mly"
+# 2416 "parsing/parser.mly"
( xs )
-# 8154 "parsing/parser.ml"
+# 8148 "parsing/parser.ml"
in
let _2 =
let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 8163 "parsing/parser.ml"
+# 8157 "parsing/parser.ml"
in
-# 3742 "parsing/parser.mly"
+# 3758 "parsing/parser.mly"
( _1, _2 )
-# 8169 "parsing/parser.ml"
+# 8163 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2196 "parsing/parser.mly"
+# 2202 "parsing/parser.mly"
( (mk_newtypes ~loc:_sloc _5 _7).pexp_desc, _2 )
-# 8178 "parsing/parser.ml"
+# 8172 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2137 "parsing/parser.mly"
+# 2143 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8189 "parsing/parser.ml"
+# 8183 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 8252 "parsing/parser.ml"
+# 8246 "parsing/parser.ml"
in
-# 1008 "parsing/parser.mly"
+# 1012 "parsing/parser.mly"
( xs )
-# 8257 "parsing/parser.ml"
+# 8251 "parsing/parser.ml"
in
-# 2519 "parsing/parser.mly"
+# 2521 "parsing/parser.mly"
( xs )
-# 8263 "parsing/parser.ml"
+# 8257 "parsing/parser.ml"
in
let _2 =
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 8273 "parsing/parser.ml"
+# 8267 "parsing/parser.ml"
in
-# 3742 "parsing/parser.mly"
+# 3758 "parsing/parser.mly"
( _1, _2 )
-# 8279 "parsing/parser.ml"
+# 8273 "parsing/parser.ml"
in
-# 2198 "parsing/parser.mly"
+# 2204 "parsing/parser.mly"
( Pexp_match(_3, _5), _2 )
-# 8285 "parsing/parser.ml"
+# 8279 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_xs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2137 "parsing/parser.mly"
+# 2143 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8296 "parsing/parser.ml"
+# 8290 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 8359 "parsing/parser.ml"
+# 8353 "parsing/parser.ml"
in
-# 1008 "parsing/parser.mly"
+# 1012 "parsing/parser.mly"
( xs )
-# 8364 "parsing/parser.ml"
+# 8358 "parsing/parser.ml"
in
-# 2519 "parsing/parser.mly"
+# 2521 "parsing/parser.mly"
( xs )
-# 8370 "parsing/parser.ml"
+# 8364 "parsing/parser.ml"
in
let _2 =
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 8380 "parsing/parser.ml"
+# 8374 "parsing/parser.ml"
in
-# 3742 "parsing/parser.mly"
+# 3758 "parsing/parser.mly"
( _1, _2 )
-# 8386 "parsing/parser.ml"
+# 8380 "parsing/parser.ml"
in
-# 2200 "parsing/parser.mly"
+# 2206 "parsing/parser.mly"
( Pexp_try(_3, _5), _2 )
-# 8392 "parsing/parser.ml"
+# 8386 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_xs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2137 "parsing/parser.mly"
+# 2143 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8403 "parsing/parser.ml"
+# 8397 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 8468 "parsing/parser.ml"
+# 8462 "parsing/parser.ml"
in
-# 3742 "parsing/parser.mly"
+# 3758 "parsing/parser.mly"
( _1, _2 )
-# 8474 "parsing/parser.ml"
+# 8468 "parsing/parser.ml"
in
-# 2202 "parsing/parser.mly"
+# 2208 "parsing/parser.mly"
( syntax_error() )
-# 8480 "parsing/parser.ml"
+# 8474 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2137 "parsing/parser.mly"
+# 2143 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8491 "parsing/parser.ml"
+# 8485 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 8570 "parsing/parser.ml"
+# 8564 "parsing/parser.ml"
in
-# 3742 "parsing/parser.mly"
+# 3758 "parsing/parser.mly"
( _1, _2 )
-# 8576 "parsing/parser.ml"
+# 8570 "parsing/parser.ml"
in
-# 2204 "parsing/parser.mly"
+# 2210 "parsing/parser.mly"
( Pexp_ifthenelse(_3, _5, Some _7), _2 )
-# 8582 "parsing/parser.ml"
+# 8576 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2137 "parsing/parser.mly"
+# 2143 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8593 "parsing/parser.ml"
+# 8587 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 8658 "parsing/parser.ml"
+# 8652 "parsing/parser.ml"
in
-# 3742 "parsing/parser.mly"
+# 3758 "parsing/parser.mly"
( _1, _2 )
-# 8664 "parsing/parser.ml"
+# 8658 "parsing/parser.ml"
in
-# 2206 "parsing/parser.mly"
+# 2212 "parsing/parser.mly"
( Pexp_ifthenelse(_3, _5, None), _2 )
-# 8670 "parsing/parser.ml"
+# 8664 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2137 "parsing/parser.mly"
+# 2143 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8681 "parsing/parser.ml"
+# 8675 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 8753 "parsing/parser.ml"
+# 8747 "parsing/parser.ml"
in
-# 3742 "parsing/parser.mly"
+# 3758 "parsing/parser.mly"
( _1, _2 )
-# 8759 "parsing/parser.ml"
+# 8753 "parsing/parser.ml"
in
-# 2208 "parsing/parser.mly"
+# 2214 "parsing/parser.mly"
( Pexp_while(_3, _5), _2 )
-# 8765 "parsing/parser.ml"
+# 8759 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2137 "parsing/parser.mly"
+# 2143 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8776 "parsing/parser.ml"
+# 8770 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 8876 "parsing/parser.ml"
+# 8870 "parsing/parser.ml"
in
-# 3742 "parsing/parser.mly"
+# 3758 "parsing/parser.mly"
( _1, _2 )
-# 8882 "parsing/parser.ml"
+# 8876 "parsing/parser.ml"
in
-# 2211 "parsing/parser.mly"
+# 2217 "parsing/parser.mly"
( Pexp_for(_3, _5, _7, _6, _9), _2 )
-# 8888 "parsing/parser.ml"
+# 8882 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__10_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2137 "parsing/parser.mly"
+# 2143 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8899 "parsing/parser.ml"
+# 8893 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 8950 "parsing/parser.ml"
+# 8944 "parsing/parser.ml"
in
-# 3742 "parsing/parser.mly"
+# 3758 "parsing/parser.mly"
( _1, _2 )
-# 8956 "parsing/parser.ml"
+# 8950 "parsing/parser.ml"
in
-# 2213 "parsing/parser.mly"
+# 2219 "parsing/parser.mly"
( Pexp_assert _3, _2 )
-# 8962 "parsing/parser.ml"
+# 8956 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2137 "parsing/parser.mly"
+# 2143 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8973 "parsing/parser.ml"
+# 8967 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 9024 "parsing/parser.ml"
+# 9018 "parsing/parser.ml"
in
-# 3742 "parsing/parser.mly"
+# 3758 "parsing/parser.mly"
( _1, _2 )
-# 9030 "parsing/parser.ml"
+# 9024 "parsing/parser.ml"
in
-# 2215 "parsing/parser.mly"
+# 2221 "parsing/parser.mly"
( Pexp_lazy _3, _2 )
-# 9036 "parsing/parser.ml"
+# 9030 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2137 "parsing/parser.mly"
+# 2143 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 9047 "parsing/parser.ml"
+# 9041 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
# 260 "<standard.mly>"
( List.flatten xss )
-# 9112 "parsing/parser.ml"
+# 9106 "parsing/parser.ml"
in
-# 1821 "parsing/parser.mly"
+# 1827 "parsing/parser.mly"
( _1 )
-# 9117 "parsing/parser.ml"
+# 9111 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 807 "parsing/parser.mly"
+# 811 "parsing/parser.mly"
( extra_cstr _startpos _endpos _1 )
-# 9126 "parsing/parser.ml"
+# 9120 "parsing/parser.ml"
in
-# 1808 "parsing/parser.mly"
+# 1814 "parsing/parser.mly"
( Cstr.mk _1 _2 )
-# 9132 "parsing/parser.ml"
+# 9126 "parsing/parser.ml"
in
let _2 =
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 9142 "parsing/parser.ml"
+# 9136 "parsing/parser.ml"
in
-# 3742 "parsing/parser.mly"
+# 3758 "parsing/parser.mly"
( _1, _2 )
-# 9148 "parsing/parser.ml"
+# 9142 "parsing/parser.ml"
in
-# 2217 "parsing/parser.mly"
+# 2223 "parsing/parser.mly"
( Pexp_object _3, _2 )
-# 9154 "parsing/parser.ml"
+# 9148 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2137 "parsing/parser.mly"
+# 2143 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 9165 "parsing/parser.ml"
+# 9159 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
# 260 "<standard.mly>"
( List.flatten xss )
-# 9230 "parsing/parser.ml"
+# 9224 "parsing/parser.ml"
in
-# 1821 "parsing/parser.mly"
+# 1827 "parsing/parser.mly"
( _1 )
-# 9235 "parsing/parser.ml"
+# 9229 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 807 "parsing/parser.mly"
+# 811 "parsing/parser.mly"
( extra_cstr _startpos _endpos _1 )
-# 9244 "parsing/parser.ml"
+# 9238 "parsing/parser.ml"
in
-# 1808 "parsing/parser.mly"
+# 1814 "parsing/parser.mly"
( Cstr.mk _1 _2 )
-# 9250 "parsing/parser.ml"
+# 9244 "parsing/parser.ml"
in
let _2 =
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 9260 "parsing/parser.ml"
+# 9254 "parsing/parser.ml"
in
-# 3742 "parsing/parser.mly"
+# 3758 "parsing/parser.mly"
( _1, _2 )
-# 9266 "parsing/parser.ml"
+# 9260 "parsing/parser.ml"
in
let _loc__4_ = (_startpos__4_, _endpos__4_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2219 "parsing/parser.mly"
+# 2225 "parsing/parser.mly"
( unclosed "object" _loc__1_ "end" _loc__4_ )
-# 9274 "parsing/parser.ml"
+# 9268 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2137 "parsing/parser.mly"
+# 2143 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 9285 "parsing/parser.ml"
+# 9279 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 9320 "parsing/parser.ml"
+# 9314 "parsing/parser.ml"
in
-# 915 "parsing/parser.mly"
+# 919 "parsing/parser.mly"
( xs )
-# 9325 "parsing/parser.ml"
+# 9319 "parsing/parser.ml"
in
-# 2223 "parsing/parser.mly"
+# 2229 "parsing/parser.mly"
( Pexp_apply(_1, _2) )
-# 9331 "parsing/parser.ml"
+# 9325 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_xs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9341 "parsing/parser.ml"
+# 9335 "parsing/parser.ml"
in
-# 2140 "parsing/parser.mly"
+# 2146 "parsing/parser.mly"
( _1 )
-# 9347 "parsing/parser.ml"
+# 9341 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 9376 "parsing/parser.ml"
+# 9370 "parsing/parser.ml"
in
-# 975 "parsing/parser.mly"
+# 979 "parsing/parser.mly"
( xs )
-# 9381 "parsing/parser.ml"
+# 9375 "parsing/parser.ml"
in
-# 2546 "parsing/parser.mly"
+# 2548 "parsing/parser.mly"
( es )
-# 9387 "parsing/parser.ml"
+# 9381 "parsing/parser.ml"
in
-# 2225 "parsing/parser.mly"
+# 2231 "parsing/parser.mly"
( Pexp_tuple(_1) )
-# 9393 "parsing/parser.ml"
+# 9387 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_xs_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9403 "parsing/parser.ml"
+# 9397 "parsing/parser.ml"
in
-# 2140 "parsing/parser.mly"
+# 2146 "parsing/parser.mly"
( _1 )
-# 9409 "parsing/parser.ml"
+# 9403 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 9447 "parsing/parser.ml"
+# 9441 "parsing/parser.ml"
in
-# 2227 "parsing/parser.mly"
+# 2233 "parsing/parser.mly"
( Pexp_construct(_1, Some _2) )
-# 9453 "parsing/parser.ml"
+# 9447 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9463 "parsing/parser.ml"
+# 9457 "parsing/parser.ml"
in
-# 2140 "parsing/parser.mly"
+# 2146 "parsing/parser.mly"
( _1 )
-# 9469 "parsing/parser.ml"
+# 9463 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2229 "parsing/parser.mly"
+# 2235 "parsing/parser.mly"
( Pexp_variant(_1, Some _2) )
-# 9502 "parsing/parser.ml"
+# 9496 "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
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9511 "parsing/parser.ml"
+# 9505 "parsing/parser.ml"
in
-# 2140 "parsing/parser.mly"
+# 2146 "parsing/parser.mly"
( _1 )
-# 9517 "parsing/parser.ml"
+# 9511 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let e2 : (Parsetree.expression) = Obj.magic e2 in
let op : (
-# 623 "parsing/parser.mly"
+# 627 "parsing/parser.mly"
(string)
-# 9551 "parsing/parser.ml"
+# 9545 "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 =
-# 3443 "parsing/parser.mly"
+# 3459 "parsing/parser.mly"
( op )
-# 9563 "parsing/parser.ml"
+# 9557 "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
-# 840 "parsing/parser.mly"
+# 844 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 9572 "parsing/parser.ml"
+# 9566 "parsing/parser.ml"
in
-# 2231 "parsing/parser.mly"
+# 2237 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 9578 "parsing/parser.ml"
+# 9572 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9588 "parsing/parser.ml"
+# 9582 "parsing/parser.ml"
in
-# 2140 "parsing/parser.mly"
+# 2146 "parsing/parser.mly"
( _1 )
-# 9594 "parsing/parser.ml"
+# 9588 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let e2 : (Parsetree.expression) = Obj.magic e2 in
let op : (
-# 624 "parsing/parser.mly"
+# 628 "parsing/parser.mly"
(string)
-# 9628 "parsing/parser.ml"
+# 9622 "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 =
-# 3444 "parsing/parser.mly"
+# 3460 "parsing/parser.mly"
( op )
-# 9640 "parsing/parser.ml"
+# 9634 "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
-# 840 "parsing/parser.mly"
+# 844 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 9649 "parsing/parser.ml"
+# 9643 "parsing/parser.ml"
in
-# 2231 "parsing/parser.mly"
+# 2237 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 9655 "parsing/parser.ml"
+# 9649 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
+# 9659 "parsing/parser.ml"
+
+ in
+
+# 2146 "parsing/parser.mly"
+ ( _1 )
# 9665 "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 = e2;
+ MenhirLib.EngineTypes.startp = _startpos_e2_;
+ MenhirLib.EngineTypes.endp = _endpos_e2_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = op;
+ MenhirLib.EngineTypes.startp = _startpos_op_;
+ MenhirLib.EngineTypes.endp = _endpos_op_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = e1;
+ MenhirLib.EngineTypes.startp = _startpos_e1_;
+ MenhirLib.EngineTypes.endp = _endpos_e1_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ };
+ };
+ } = _menhir_stack in
+ let e2 : (Parsetree.expression) = Obj.magic e2 in
+ let op : (
+# 629 "parsing/parser.mly"
+ (string)
+# 9699 "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 _startpos = _startpos_e1_ in
+ let _endpos = _endpos_e2_ in
+ let _v : (Parsetree.expression) = let _1 =
+ let _1 =
+ let op =
+ let _1 =
+# 3461 "parsing/parser.mly"
+ ( op )
+# 9711 "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
+
+# 844 "parsing/parser.mly"
+ ( mkoperator ~loc:_sloc _1 )
+# 9720 "parsing/parser.ml"
+
+ in
+
+# 2237 "parsing/parser.mly"
+ ( mkinfix e1 op e2 )
+# 9726 "parsing/parser.ml"
+
+ in
+ let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
+ let _endpos = _endpos__1_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
+
+# 850 "parsing/parser.mly"
+ ( mkexp ~loc:_sloc _1 )
+# 9736 "parsing/parser.ml"
in
-# 2140 "parsing/parser.mly"
+# 2146 "parsing/parser.mly"
( _1 )
-# 9671 "parsing/parser.ml"
+# 9742 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let e2 : (Parsetree.expression) = Obj.magic e2 in
let op : (
-# 625 "parsing/parser.mly"
+# 630 "parsing/parser.mly"
(string)
-# 9705 "parsing/parser.ml"
+# 9776 "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 =
-# 3445 "parsing/parser.mly"
+# 3462 "parsing/parser.mly"
( op )
-# 9717 "parsing/parser.ml"
+# 9788 "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
-# 840 "parsing/parser.mly"
+# 844 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 9726 "parsing/parser.ml"
+# 9797 "parsing/parser.ml"
in
-# 2231 "parsing/parser.mly"
+# 2237 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 9732 "parsing/parser.ml"
-
- in
- let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
- let _endpos = _endpos__1_ in
- let _symbolstartpos = _startpos__1_ in
- let _sloc = (_symbolstartpos, _endpos) in
-
-# 846 "parsing/parser.mly"
- ( mkexp ~loc:_sloc _1 )
-# 9742 "parsing/parser.ml"
-
- in
-
-# 2140 "parsing/parser.mly"
- ( _1 )
-# 9748 "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 = e2;
- MenhirLib.EngineTypes.startp = _startpos_e2_;
- MenhirLib.EngineTypes.endp = _endpos_e2_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = op;
- MenhirLib.EngineTypes.startp = _startpos_op_;
- MenhirLib.EngineTypes.endp = _endpos_op_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = e1;
- MenhirLib.EngineTypes.startp = _startpos_e1_;
- MenhirLib.EngineTypes.endp = _endpos_e1_;
- MenhirLib.EngineTypes.next = _menhir_stack;
- };
- };
- } = _menhir_stack in
- let e2 : (Parsetree.expression) = Obj.magic e2 in
- let op : (
-# 626 "parsing/parser.mly"
- (string)
-# 9782 "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 _startpos = _startpos_e1_ in
- let _endpos = _endpos_e2_ in
- let _v : (Parsetree.expression) = let _1 =
- let _1 =
- let op =
- let _1 =
-# 3446 "parsing/parser.mly"
- ( op )
-# 9794 "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
-
-# 840 "parsing/parser.mly"
- ( mkoperator ~loc:_sloc _1 )
# 9803 "parsing/parser.ml"
-
- in
-
-# 2231 "parsing/parser.mly"
- ( mkinfix e1 op e2 )
-# 9809 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9819 "parsing/parser.ml"
+# 9813 "parsing/parser.ml"
in
-# 2140 "parsing/parser.mly"
+# 2146 "parsing/parser.mly"
( _1 )
-# 9825 "parsing/parser.ml"
+# 9819 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let e2 : (Parsetree.expression) = Obj.magic e2 in
let op : (
-# 627 "parsing/parser.mly"
+# 631 "parsing/parser.mly"
(string)
-# 9859 "parsing/parser.ml"
+# 9853 "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 =
-# 3447 "parsing/parser.mly"
+# 3463 "parsing/parser.mly"
( op )
-# 9871 "parsing/parser.ml"
+# 9865 "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
-# 840 "parsing/parser.mly"
+# 844 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 9880 "parsing/parser.ml"
+# 9874 "parsing/parser.ml"
in
-# 2231 "parsing/parser.mly"
+# 2237 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 9886 "parsing/parser.ml"
+# 9880 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9896 "parsing/parser.ml"
+# 9890 "parsing/parser.ml"
in
-# 2140 "parsing/parser.mly"
+# 2146 "parsing/parser.mly"
( _1 )
-# 9902 "parsing/parser.ml"
+# 9896 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3448 "parsing/parser.mly"
+# 3464 "parsing/parser.mly"
("+")
-# 9944 "parsing/parser.ml"
+# 9938 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 840 "parsing/parser.mly"
+# 844 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 9952 "parsing/parser.ml"
+# 9946 "parsing/parser.ml"
in
-# 2231 "parsing/parser.mly"
+# 2237 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 9958 "parsing/parser.ml"
+# 9952 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9968 "parsing/parser.ml"
+# 9962 "parsing/parser.ml"
in
-# 2140 "parsing/parser.mly"
+# 2146 "parsing/parser.mly"
( _1 )
-# 9974 "parsing/parser.ml"
+# 9968 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3449 "parsing/parser.mly"
+# 3465 "parsing/parser.mly"
("+.")
-# 10016 "parsing/parser.ml"
+# 10010 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 840 "parsing/parser.mly"
+# 844 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10024 "parsing/parser.ml"
+# 10018 "parsing/parser.ml"
in
-# 2231 "parsing/parser.mly"
+# 2237 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10030 "parsing/parser.ml"
+# 10024 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10040 "parsing/parser.ml"
+# 10034 "parsing/parser.ml"
in
-# 2140 "parsing/parser.mly"
+# 2146 "parsing/parser.mly"
( _1 )
-# 10046 "parsing/parser.ml"
+# 10040 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3450 "parsing/parser.mly"
+# 3466 "parsing/parser.mly"
("+=")
-# 10088 "parsing/parser.ml"
+# 10082 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 840 "parsing/parser.mly"
+# 844 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10096 "parsing/parser.ml"
+# 10090 "parsing/parser.ml"
in
-# 2231 "parsing/parser.mly"
+# 2237 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10102 "parsing/parser.ml"
+# 10096 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10112 "parsing/parser.ml"
+# 10106 "parsing/parser.ml"
in
-# 2140 "parsing/parser.mly"
+# 2146 "parsing/parser.mly"
( _1 )
-# 10118 "parsing/parser.ml"
+# 10112 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3451 "parsing/parser.mly"
+# 3467 "parsing/parser.mly"
("-")
-# 10160 "parsing/parser.ml"
+# 10154 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 840 "parsing/parser.mly"
+# 844 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10168 "parsing/parser.ml"
+# 10162 "parsing/parser.ml"
in
-# 2231 "parsing/parser.mly"
+# 2237 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10174 "parsing/parser.ml"
+# 10168 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10184 "parsing/parser.ml"
+# 10178 "parsing/parser.ml"
in
-# 2140 "parsing/parser.mly"
+# 2146 "parsing/parser.mly"
( _1 )
-# 10190 "parsing/parser.ml"
+# 10184 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3452 "parsing/parser.mly"
+# 3468 "parsing/parser.mly"
("-.")
-# 10232 "parsing/parser.ml"
+# 10226 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 840 "parsing/parser.mly"
+# 844 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10240 "parsing/parser.ml"
+# 10234 "parsing/parser.ml"
in
-# 2231 "parsing/parser.mly"
+# 2237 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10246 "parsing/parser.ml"
+# 10240 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10256 "parsing/parser.ml"
+# 10250 "parsing/parser.ml"
in
-# 2140 "parsing/parser.mly"
+# 2146 "parsing/parser.mly"
( _1 )
-# 10262 "parsing/parser.ml"
+# 10256 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3453 "parsing/parser.mly"
+# 3469 "parsing/parser.mly"
("*")
-# 10304 "parsing/parser.ml"
+# 10298 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 840 "parsing/parser.mly"
+# 844 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10312 "parsing/parser.ml"
+# 10306 "parsing/parser.ml"
in
-# 2231 "parsing/parser.mly"
+# 2237 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10318 "parsing/parser.ml"
+# 10312 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10328 "parsing/parser.ml"
+# 10322 "parsing/parser.ml"
in
-# 2140 "parsing/parser.mly"
+# 2146 "parsing/parser.mly"
( _1 )
-# 10334 "parsing/parser.ml"
+# 10328 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3454 "parsing/parser.mly"
+# 3470 "parsing/parser.mly"
("%")
-# 10376 "parsing/parser.ml"
+# 10370 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 840 "parsing/parser.mly"
+# 844 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10384 "parsing/parser.ml"
+# 10378 "parsing/parser.ml"
in
-# 2231 "parsing/parser.mly"
+# 2237 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10390 "parsing/parser.ml"
+# 10384 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10400 "parsing/parser.ml"
+# 10394 "parsing/parser.ml"
in
-# 2140 "parsing/parser.mly"
+# 2146 "parsing/parser.mly"
( _1 )
-# 10406 "parsing/parser.ml"
+# 10400 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3455 "parsing/parser.mly"
+# 3471 "parsing/parser.mly"
("=")
-# 10448 "parsing/parser.ml"
+# 10442 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 840 "parsing/parser.mly"
+# 844 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10456 "parsing/parser.ml"
+# 10450 "parsing/parser.ml"
in
-# 2231 "parsing/parser.mly"
+# 2237 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10462 "parsing/parser.ml"
+# 10456 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10472 "parsing/parser.ml"
+# 10466 "parsing/parser.ml"
in
-# 2140 "parsing/parser.mly"
+# 2146 "parsing/parser.mly"
( _1 )
-# 10478 "parsing/parser.ml"
+# 10472 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3456 "parsing/parser.mly"
+# 3472 "parsing/parser.mly"
("<")
-# 10520 "parsing/parser.ml"
+# 10514 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 840 "parsing/parser.mly"
+# 844 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10528 "parsing/parser.ml"
+# 10522 "parsing/parser.ml"
in
-# 2231 "parsing/parser.mly"
+# 2237 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10534 "parsing/parser.ml"
+# 10528 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10544 "parsing/parser.ml"
+# 10538 "parsing/parser.ml"
in
-# 2140 "parsing/parser.mly"
+# 2146 "parsing/parser.mly"
( _1 )
-# 10550 "parsing/parser.ml"
+# 10544 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3457 "parsing/parser.mly"
+# 3473 "parsing/parser.mly"
(">")
-# 10592 "parsing/parser.ml"
+# 10586 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 840 "parsing/parser.mly"
+# 844 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10600 "parsing/parser.ml"
+# 10594 "parsing/parser.ml"
in
-# 2231 "parsing/parser.mly"
+# 2237 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10606 "parsing/parser.ml"
+# 10600 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10616 "parsing/parser.ml"
+# 10610 "parsing/parser.ml"
in
-# 2140 "parsing/parser.mly"
+# 2146 "parsing/parser.mly"
( _1 )
-# 10622 "parsing/parser.ml"
+# 10616 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3458 "parsing/parser.mly"
+# 3474 "parsing/parser.mly"
("or")
-# 10664 "parsing/parser.ml"
+# 10658 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 840 "parsing/parser.mly"
+# 844 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10672 "parsing/parser.ml"
+# 10666 "parsing/parser.ml"
in
-# 2231 "parsing/parser.mly"
+# 2237 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10678 "parsing/parser.ml"
+# 10672 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10688 "parsing/parser.ml"
+# 10682 "parsing/parser.ml"
in
-# 2140 "parsing/parser.mly"
+# 2146 "parsing/parser.mly"
( _1 )
-# 10694 "parsing/parser.ml"
+# 10688 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3459 "parsing/parser.mly"
+# 3475 "parsing/parser.mly"
("||")
-# 10736 "parsing/parser.ml"
+# 10730 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 840 "parsing/parser.mly"
+# 844 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10744 "parsing/parser.ml"
+# 10738 "parsing/parser.ml"
in
-# 2231 "parsing/parser.mly"
+# 2237 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10750 "parsing/parser.ml"
+# 10744 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10760 "parsing/parser.ml"
+# 10754 "parsing/parser.ml"
in
-# 2140 "parsing/parser.mly"
+# 2146 "parsing/parser.mly"
( _1 )
-# 10766 "parsing/parser.ml"
+# 10760 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3460 "parsing/parser.mly"
+# 3476 "parsing/parser.mly"
("&")
-# 10808 "parsing/parser.ml"
+# 10802 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 840 "parsing/parser.mly"
+# 844 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10816 "parsing/parser.ml"
+# 10810 "parsing/parser.ml"
in
-# 2231 "parsing/parser.mly"
+# 2237 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10822 "parsing/parser.ml"
+# 10816 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10832 "parsing/parser.ml"
+# 10826 "parsing/parser.ml"
in
-# 2140 "parsing/parser.mly"
+# 2146 "parsing/parser.mly"
( _1 )
-# 10838 "parsing/parser.ml"
+# 10832 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3461 "parsing/parser.mly"
+# 3477 "parsing/parser.mly"
("&&")
-# 10880 "parsing/parser.ml"
+# 10874 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 840 "parsing/parser.mly"
+# 844 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10888 "parsing/parser.ml"
+# 10882 "parsing/parser.ml"
in
-# 2231 "parsing/parser.mly"
+# 2237 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10894 "parsing/parser.ml"
+# 10888 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10904 "parsing/parser.ml"
+# 10898 "parsing/parser.ml"
in
-# 2140 "parsing/parser.mly"
+# 2146 "parsing/parser.mly"
( _1 )
-# 10910 "parsing/parser.ml"
+# 10904 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3462 "parsing/parser.mly"
+# 3478 "parsing/parser.mly"
(":=")
-# 10952 "parsing/parser.ml"
+# 10946 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 840 "parsing/parser.mly"
+# 844 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10960 "parsing/parser.ml"
+# 10954 "parsing/parser.ml"
in
-# 2231 "parsing/parser.mly"
+# 2237 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10966 "parsing/parser.ml"
+# 10960 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10976 "parsing/parser.ml"
+# 10970 "parsing/parser.ml"
in
-# 2140 "parsing/parser.mly"
+# 2146 "parsing/parser.mly"
( _1 )
-# 10982 "parsing/parser.ml"
+# 10976 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2233 "parsing/parser.mly"
+# 2239 "parsing/parser.mly"
( mkuminus ~oploc:_loc__1_ _1 _2 )
-# 11017 "parsing/parser.ml"
+# 11011 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 11027 "parsing/parser.ml"
+# 11021 "parsing/parser.ml"
in
-# 2140 "parsing/parser.mly"
+# 2146 "parsing/parser.mly"
( _1 )
-# 11033 "parsing/parser.ml"
+# 11027 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2235 "parsing/parser.mly"
+# 2241 "parsing/parser.mly"
( mkuplus ~oploc:_loc__1_ _1 _2 )
-# 11068 "parsing/parser.ml"
+# 11062 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 11078 "parsing/parser.ml"
+# 11072 "parsing/parser.ml"
in
-# 2140 "parsing/parser.mly"
+# 2146 "parsing/parser.mly"
( _1 )
-# 11084 "parsing/parser.ml"
+# 11078 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2142 "parsing/parser.mly"
+# 2148 "parsing/parser.mly"
( expr_of_let_bindings ~loc:_sloc _1 _3 )
-# 11126 "parsing/parser.ml"
+# 11120 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 : unit = Obj.magic _3 in
let bindings : (Parsetree.pattern * Parsetree.expression * Parsetree.binding_op list) = Obj.magic bindings in
let _1 : (
-# 629 "parsing/parser.mly"
+# 633 "parsing/parser.mly"
(string)
-# 11168 "parsing/parser.ml"
+# 11162 "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
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 11180 "parsing/parser.ml"
+# 11174 "parsing/parser.ml"
in
let _startpos_pbop_op_ = _startpos__1_ in
let _symbolstartpos = _startpos_pbop_op_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2144 "parsing/parser.mly"
+# 2150 "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}) )
-# 11194 "parsing/parser.ml"
+# 11188 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__2_ = (_startpos__2_, _endpos__2_) in
let _sloc = (_symbolstartpos, _endpos) in
-# 2150 "parsing/parser.mly"
+# 2156 "parsing/parser.mly"
( mkexp_cons ~loc:_sloc _loc__2_ (ghexp ~loc:_sloc (Pexp_tuple[_1;_3])) )
-# 11237 "parsing/parser.ml"
+# 11231 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 : (Parsetree.expression) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 11272 "parsing/parser.ml"
+# 11266 "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 =
-# 3393 "parsing/parser.mly"
+# 3409 "parsing/parser.mly"
( _1 )
-# 11281 "parsing/parser.ml"
+# 11275 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 11289 "parsing/parser.ml"
+# 11283 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2152 "parsing/parser.mly"
+# 2158 "parsing/parser.mly"
( mkexp ~loc:_sloc (Pexp_setinstvar(_1, _3)) )
-# 11298 "parsing/parser.ml"
+# 11292 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 11356 "parsing/parser.ml"
+# 11350 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2154 "parsing/parser.mly"
+# 2160 "parsing/parser.mly"
( mkexp ~loc:_sloc (Pexp_setfield(_1, _3, _5)) )
-# 11365 "parsing/parser.ml"
+# 11359 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2156 "parsing/parser.mly"
+# 2162 "parsing/parser.mly"
( array_set ~loc:_sloc _1 _4 _7 )
-# 11435 "parsing/parser.ml"
+# 11429 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2158 "parsing/parser.mly"
+# 2164 "parsing/parser.mly"
( string_set ~loc:_sloc _1 _4 _7 )
-# 11505 "parsing/parser.ml"
+# 11499 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2160 "parsing/parser.mly"
+# 2166 "parsing/parser.mly"
( bigarray_set ~loc:_sloc _1 _4 _7 )
-# 11575 "parsing/parser.ml"
+# 11569 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 628 "parsing/parser.mly"
+# 632 "parsing/parser.mly"
(string)
-# 11637 "parsing/parser.ml"
+# 11631 "parsing/parser.ml"
) = Obj.magic _2 in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__7_ in
let _v : (Parsetree.expression) = let _4 =
-# 2586 "parsing/parser.mly"
+# 2588 "parsing/parser.mly"
( es )
-# 11646 "parsing/parser.ml"
+# 11640 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2162 "parsing/parser.mly"
+# 2168 "parsing/parser.mly"
( dotop_set ~loc:_sloc lident bracket _2 _1 _4 _7 )
-# 11654 "parsing/parser.ml"
+# 11648 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 628 "parsing/parser.mly"
+# 632 "parsing/parser.mly"
(string)
-# 11716 "parsing/parser.ml"
+# 11710 "parsing/parser.ml"
) = Obj.magic _2 in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__7_ in
let _v : (Parsetree.expression) = let _4 =
-# 2586 "parsing/parser.mly"
+# 2588 "parsing/parser.mly"
( es )
-# 11725 "parsing/parser.ml"
+# 11719 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2164 "parsing/parser.mly"
+# 2170 "parsing/parser.mly"
( dotop_set ~loc:_sloc lident paren _2 _1 _4 _7 )
-# 11733 "parsing/parser.ml"
+# 11727 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 628 "parsing/parser.mly"
+# 632 "parsing/parser.mly"
(string)
-# 11795 "parsing/parser.ml"
+# 11789 "parsing/parser.ml"
) = Obj.magic _2 in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__7_ in
let _v : (Parsetree.expression) = let _4 =
-# 2586 "parsing/parser.mly"
+# 2588 "parsing/parser.mly"
( es )
-# 11804 "parsing/parser.ml"
+# 11798 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2166 "parsing/parser.mly"
+# 2172 "parsing/parser.mly"
( dotop_set ~loc:_sloc lident brace _2 _1 _4 _7 )
-# 11812 "parsing/parser.ml"
+# 11806 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let es : (Parsetree.expression list) = Obj.magic es in
let _5 : unit = Obj.magic _5 in
let _4 : (
-# 628 "parsing/parser.mly"
+# 632 "parsing/parser.mly"
(string)
-# 11886 "parsing/parser.ml"
+# 11880 "parsing/parser.ml"
) = Obj.magic _4 in
let _3 : (Longident.t) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _startpos = _startpos__1_ in
let _endpos = _endpos__9_ in
let _v : (Parsetree.expression) = let _6 =
-# 2586 "parsing/parser.mly"
+# 2588 "parsing/parser.mly"
( es )
-# 11897 "parsing/parser.ml"
+# 11891 "parsing/parser.ml"
in
let _endpos = _endpos__9_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2169 "parsing/parser.mly"
+# 2175 "parsing/parser.mly"
( dotop_set ~loc:_sloc (ldot _3) bracket _4 _1 _6 _9 )
-# 11905 "parsing/parser.ml"
+# 11899 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let es : (Parsetree.expression list) = Obj.magic es in
let _5 : unit = Obj.magic _5 in
let _4 : (
-# 628 "parsing/parser.mly"
+# 632 "parsing/parser.mly"
(string)
-# 11979 "parsing/parser.ml"
+# 11973 "parsing/parser.ml"
) = Obj.magic _4 in
let _3 : (Longident.t) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _startpos = _startpos__1_ in
let _endpos = _endpos__9_ in
let _v : (Parsetree.expression) = let _6 =
-# 2586 "parsing/parser.mly"
+# 2588 "parsing/parser.mly"
( es )
-# 11990 "parsing/parser.ml"
+# 11984 "parsing/parser.ml"
in
let _endpos = _endpos__9_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2172 "parsing/parser.mly"
+# 2178 "parsing/parser.mly"
( dotop_set ~loc:_sloc (ldot _3) paren _4 _1 _6 _9 )
-# 11998 "parsing/parser.ml"
+# 11992 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let es : (Parsetree.expression list) = Obj.magic es in
let _5 : unit = Obj.magic _5 in
let _4 : (
-# 628 "parsing/parser.mly"
+# 632 "parsing/parser.mly"
(string)
-# 12072 "parsing/parser.ml"
+# 12066 "parsing/parser.ml"
) = Obj.magic _4 in
let _3 : (Longident.t) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _startpos = _startpos__1_ in
let _endpos = _endpos__9_ in
let _v : (Parsetree.expression) = let _6 =
-# 2586 "parsing/parser.mly"
+# 2588 "parsing/parser.mly"
( es )
-# 12083 "parsing/parser.ml"
+# 12077 "parsing/parser.ml"
in
let _endpos = _endpos__9_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2175 "parsing/parser.mly"
+# 2181 "parsing/parser.mly"
( dotop_set ~loc:_sloc (ldot _3) brace _4 _1 _6 _9 )
-# 12091 "parsing/parser.ml"
+# 12085 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) =
-# 2177 "parsing/parser.mly"
+# 2183 "parsing/parser.mly"
( Exp.attr _1 _2 )
-# 12123 "parsing/parser.ml"
+# 12117 "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
-# 2179 "parsing/parser.mly"
+# 2185 "parsing/parser.mly"
( not_expecting _loc__1_ "wildcard \"_\"" )
-# 12149 "parsing/parser.ml"
+# 12143 "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) =
-# 3734 "parsing/parser.mly"
+# 3750 "parsing/parser.mly"
( None )
-# 12167 "parsing/parser.ml"
+# 12161 "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) =
-# 3735 "parsing/parser.mly"
+# 3751 "parsing/parser.mly"
( Some _2 )
-# 12199 "parsing/parser.ml"
+# 12193 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (Parsetree.extension) =
-# 3745 "parsing/parser.mly"
+# 3761 "parsing/parser.mly"
( (_2, _3) )
-# 12245 "parsing/parser.ml"
+# 12239 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 687 "parsing/parser.mly"
+# 691 "parsing/parser.mly"
(string * Location.t * string * Location.t * string option)
-# 12266 "parsing/parser.ml"
+# 12260 "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
-# 3747 "parsing/parser.mly"
+# 3763 "parsing/parser.mly"
( mk_quotedext ~loc:_sloc _1 )
-# 12277 "parsing/parser.ml"
+# 12271 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.extension_constructor) = let attrs =
let _1 = _1_inlined3 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 12332 "parsing/parser.ml"
+# 12326 "parsing/parser.ml"
in
let _endpos_attrs_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 12344 "parsing/parser.ml"
+# 12338 "parsing/parser.ml"
in
let cid =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 12355 "parsing/parser.ml"
+# 12349 "parsing/parser.ml"
in
let _endpos = _endpos_attrs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3103 "parsing/parser.mly"
+# 3119 "parsing/parser.mly"
( let info = symbol_info _endpos in
Te.rebind cid lid ~attrs ~loc:(make_loc _sloc) ~info )
-# 12365 "parsing/parser.ml"
+# 12359 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.extension_constructor) = let attrs =
let _1 = _1_inlined2 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 12413 "parsing/parser.ml"
+# 12407 "parsing/parser.ml"
in
let _endpos_attrs_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 12425 "parsing/parser.ml"
+# 12419 "parsing/parser.ml"
in
let cid =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 12435 "parsing/parser.ml"
+# 12429 "parsing/parser.ml"
in
let _startpos_cid_ = _startpos__1_ in
let _1 =
-# 3554 "parsing/parser.mly"
+# 3570 "parsing/parser.mly"
( () )
-# 12442 "parsing/parser.ml"
+# 12436 "parsing/parser.ml"
in
let _endpos = _endpos_attrs_ in
let _symbolstartpos = _startpos_cid_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3103 "parsing/parser.mly"
+# 3119 "parsing/parser.mly"
( let info = symbol_info _endpos in
Te.rebind cid lid ~attrs ~loc:(make_loc _sloc) ~info )
-# 12451 "parsing/parser.ml"
+# 12445 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3722 "parsing/parser.mly"
+# 3738 "parsing/parser.mly"
( mark_symbol_docs _sloc;
Attr.mk ~loc:(make_loc _sloc) _2 _3 )
-# 12501 "parsing/parser.ml"
+# 12495 "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.core_type * Asttypes.variance) list) = let params =
-# 1928 "parsing/parser.mly"
+ let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = let params =
+# 1934 "parsing/parser.mly"
( [] )
-# 12519 "parsing/parser.ml"
+# 12513 "parsing/parser.ml"
in
-# 1753 "parsing/parser.mly"
+# 1759 "parsing/parser.mly"
( params )
-# 12524 "parsing/parser.ml"
+# 12518 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _3 : unit = Obj.magic _3 in
- let xs : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic xs in
+ let xs : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) 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__3_ in
- let _v : ((Parsetree.core_type * Asttypes.variance) list) = let params =
+ let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = let params =
let params =
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 12565 "parsing/parser.ml"
+# 12559 "parsing/parser.ml"
in
-# 947 "parsing/parser.mly"
+# 951 "parsing/parser.mly"
( xs )
-# 12570 "parsing/parser.ml"
+# 12564 "parsing/parser.ml"
in
-# 1930 "parsing/parser.mly"
+# 1936 "parsing/parser.mly"
( params )
-# 12576 "parsing/parser.ml"
+# 12570 "parsing/parser.ml"
in
-# 1753 "parsing/parser.mly"
+# 1759 "parsing/parser.mly"
( params )
-# 12582 "parsing/parser.ml"
+# 12576 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression) =
-# 2505 "parsing/parser.mly"
+# 2507 "parsing/parser.mly"
( _1 )
-# 12607 "parsing/parser.ml"
+# 12601 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2507 "parsing/parser.mly"
+# 2509 "parsing/parser.mly"
( mkexp_constraint ~loc:_sloc _3 _1 )
-# 12649 "parsing/parser.ml"
+# 12643 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) =
-# 2531 "parsing/parser.mly"
+# 2533 "parsing/parser.mly"
( _2 )
-# 12681 "parsing/parser.ml"
+# 12675 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__4_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2533 "parsing/parser.mly"
+# 2535 "parsing/parser.mly"
( Pexp_constraint (_4, _2) )
-# 12728 "parsing/parser.ml"
+# 12722 "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
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 12737 "parsing/parser.ml"
+# 12731 "parsing/parser.ml"
in
-# 2534 "parsing/parser.mly"
+# 2536 "parsing/parser.mly"
( _1 )
-# 12743 "parsing/parser.ml"
+# 12737 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2537 "parsing/parser.mly"
+# 2539 "parsing/parser.mly"
(
let (l,o,p) = _1 in
ghexp ~loc:_sloc (Pexp_fun(l, o, p, _2))
)
-# 12781 "parsing/parser.ml"
+# 12775 "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 =
-# 2414 "parsing/parser.mly"
+# 2416 "parsing/parser.mly"
( xs )
-# 12834 "parsing/parser.ml"
+# 12828 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2542 "parsing/parser.mly"
+# 2544 "parsing/parser.mly"
( mk_newtypes ~loc:_sloc _3 _5 )
-# 12842 "parsing/parser.ml"
+# 12836 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_ty_ in
let _endpos = _endpos_ty_ in
let _v : (Parsetree.core_type) =
-# 3215 "parsing/parser.mly"
+# 3231 "parsing/parser.mly"
( ty )
-# 12867 "parsing/parser.ml"
+# 12861 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.core_type) = let _1 =
let _1 =
let domain =
-# 811 "parsing/parser.mly"
+# 815 "parsing/parser.mly"
( extra_rhs_core_type _1 ~pos:_endpos__1_ )
-# 12915 "parsing/parser.ml"
+# 12909 "parsing/parser.ml"
in
let label =
-# 3227 "parsing/parser.mly"
+# 3243 "parsing/parser.mly"
( Optional label )
-# 12920 "parsing/parser.ml"
+# 12914 "parsing/parser.ml"
in
-# 3221 "parsing/parser.mly"
+# 3237 "parsing/parser.mly"
( Ptyp_arrow(label, domain, codomain) )
-# 12925 "parsing/parser.ml"
+# 12919 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 854 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 12935 "parsing/parser.ml"
+# 12929 "parsing/parser.ml"
in
-# 3223 "parsing/parser.mly"
+# 3239 "parsing/parser.mly"
( _1 )
-# 12941 "parsing/parser.ml"
+# 12935 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (Parsetree.core_type) = Obj.magic _1 in
let _2 : unit = Obj.magic _2 in
let label : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 12990 "parsing/parser.ml"
+# 12984 "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 =
-# 811 "parsing/parser.mly"
+# 815 "parsing/parser.mly"
( extra_rhs_core_type _1 ~pos:_endpos__1_ )
-# 13000 "parsing/parser.ml"
+# 12994 "parsing/parser.ml"
in
let label =
-# 3229 "parsing/parser.mly"
+# 3245 "parsing/parser.mly"
( Labelled label )
-# 13005 "parsing/parser.ml"
+# 12999 "parsing/parser.ml"
in
-# 3221 "parsing/parser.mly"
+# 3237 "parsing/parser.mly"
( Ptyp_arrow(label, domain, codomain) )
-# 13010 "parsing/parser.ml"
+# 13004 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 854 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 13020 "parsing/parser.ml"
+# 13014 "parsing/parser.ml"
in
-# 3223 "parsing/parser.mly"
+# 3239 "parsing/parser.mly"
( _1 )
-# 13026 "parsing/parser.ml"
+# 13020 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.core_type) = let _1 =
let _1 =
let domain =
-# 811 "parsing/parser.mly"
+# 815 "parsing/parser.mly"
( extra_rhs_core_type _1 ~pos:_endpos__1_ )
-# 13067 "parsing/parser.ml"
+# 13061 "parsing/parser.ml"
in
let label =
-# 3231 "parsing/parser.mly"
+# 3247 "parsing/parser.mly"
( Nolabel )
-# 13072 "parsing/parser.ml"
+# 13066 "parsing/parser.ml"
in
-# 3221 "parsing/parser.mly"
+# 3237 "parsing/parser.mly"
( Ptyp_arrow(label, domain, codomain) )
-# 13077 "parsing/parser.ml"
+# 13071 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_codomain_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 854 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 13087 "parsing/parser.ml"
+# 13081 "parsing/parser.ml"
in
-# 3223 "parsing/parser.mly"
+# 3239 "parsing/parser.mly"
( _1 )
-# 13093 "parsing/parser.ml"
+# 13087 "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.functor_parameter) =
-# 1186 "parsing/parser.mly"
- ( Unit )
-# 13125 "parsing/parser.ml"
+ let _v : (Lexing.position * Parsetree.functor_parameter) = let _startpos = _startpos__1_ in
+
+# 1190 "parsing/parser.mly"
+ ( _startpos, Unit )
+# 13120 "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__5_ in
- let _v : (Parsetree.functor_parameter) = let x =
+ let _v : (Lexing.position * Parsetree.functor_parameter) = let x =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 13183 "parsing/parser.ml"
+# 13178 "parsing/parser.ml"
in
+ let _startpos = _startpos__1_ in
-# 1189 "parsing/parser.mly"
- ( Named (x, mty) )
-# 13189 "parsing/parser.ml"
+# 1193 "parsing/parser.mly"
+ ( _startpos, Named (x, mty) )
+# 13185 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Parsetree.constructor_arguments * Parsetree.core_type option) =
-# 3023 "parsing/parser.mly"
+# 3039 "parsing/parser.mly"
( (Pcstr_tuple [],None) )
-# 13207 "parsing/parser.ml"
+# 13203 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.constructor_arguments * Parsetree.core_type option) =
-# 3024 "parsing/parser.mly"
+# 3040 "parsing/parser.mly"
( (_2,None) )
-# 13239 "parsing/parser.ml"
+# 13235 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (Parsetree.constructor_arguments * Parsetree.core_type option) =
-# 3026 "parsing/parser.mly"
+# 3042 "parsing/parser.mly"
( (_2,Some _4) )
-# 13285 "parsing/parser.ml"
+# 13281 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.constructor_arguments * Parsetree.core_type option) =
-# 3028 "parsing/parser.mly"
+# 3044 "parsing/parser.mly"
( (Pcstr_tuple [],Some _2) )
-# 13317 "parsing/parser.ml"
+# 13313 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
Docstrings.info) = let attrs =
let _1 = _1_inlined2 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 13367 "parsing/parser.ml"
+# 13363 "parsing/parser.ml"
in
let _endpos_attrs_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 13379 "parsing/parser.ml"
+# 13375 "parsing/parser.ml"
in
let _endpos = _endpos_attrs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2971 "parsing/parser.mly"
+# 2987 "parsing/parser.mly"
(
let args, res = args_res in
let info = symbol_info _endpos in
let loc = make_loc _sloc in
cid, args, res, attrs, loc, info
)
-# 13393 "parsing/parser.ml"
+# 13389 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
Docstrings.info) = let attrs =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 13436 "parsing/parser.ml"
+# 13432 "parsing/parser.ml"
in
let _endpos_attrs_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 13447 "parsing/parser.ml"
+# 13443 "parsing/parser.ml"
in
let _startpos_cid_ = _startpos__1_ in
let _1 =
-# 3554 "parsing/parser.mly"
+# 3570 "parsing/parser.mly"
( () )
-# 13454 "parsing/parser.ml"
+# 13450 "parsing/parser.ml"
in
let _endpos = _endpos_attrs_ in
let _symbolstartpos = _startpos_cid_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2971 "parsing/parser.mly"
+# 2987 "parsing/parser.mly"
(
let args, res = args_res in
let info = symbol_info _endpos in
let loc = make_loc _sloc in
cid, args, res, attrs, loc, info
)
-# 13467 "parsing/parser.ml"
+# 13463 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic _2 in
let _1_inlined3 : unit = Obj.magic _1_inlined3 in
let _1_inlined2 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 13540 "parsing/parser.ml"
+# 13536 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
- let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params 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 ext : (string Asttypes.loc option) = Obj.magic ext in
let _1 : unit = Obj.magic _1 in
Parsetree.type_declaration) = let attrs2 =
let _1 = _1_inlined4 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 13555 "parsing/parser.ml"
+# 13551 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 13564 "parsing/parser.ml"
+# 13560 "parsing/parser.ml"
in
-# 897 "parsing/parser.mly"
+# 901 "parsing/parser.mly"
( xs )
-# 13569 "parsing/parser.ml"
+# 13565 "parsing/parser.ml"
in
-# 2887 "parsing/parser.mly"
+# 2892 "parsing/parser.mly"
( _1 )
-# 13575 "parsing/parser.ml"
+# 13571 "parsing/parser.ml"
in
let kind_priv_manifest =
let _1 = _1_inlined3 in
-# 2922 "parsing/parser.mly"
+# 2927 "parsing/parser.mly"
( _2 )
-# 13583 "parsing/parser.ml"
+# 13579 "parsing/parser.ml"
in
let id =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 13594 "parsing/parser.ml"
+# 13590 "parsing/parser.ml"
in
let flag =
-# 3574 "parsing/parser.mly"
+# 3590 "parsing/parser.mly"
( Recursive )
-# 13600 "parsing/parser.ml"
+# 13596 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 13607 "parsing/parser.ml"
+# 13603 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2859 "parsing/parser.mly"
+# 2864 "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
)
-# 13623 "parsing/parser.ml"
+# 13619 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic _2 in
let _1_inlined4 : unit = Obj.magic _1_inlined4 in
let _1_inlined3 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 13702 "parsing/parser.ml"
+# 13698 "parsing/parser.ml"
) = Obj.magic _1_inlined3 in
- let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in
+ let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let _1_inlined2 : unit = 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
Parsetree.type_declaration) = let attrs2 =
let _1 = _1_inlined5 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 13718 "parsing/parser.ml"
+# 13714 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined5_ in
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 13727 "parsing/parser.ml"
+# 13723 "parsing/parser.ml"
in
-# 897 "parsing/parser.mly"
+# 901 "parsing/parser.mly"
( xs )
-# 13732 "parsing/parser.ml"
+# 13728 "parsing/parser.ml"
in
-# 2887 "parsing/parser.mly"
+# 2892 "parsing/parser.mly"
( _1 )
-# 13738 "parsing/parser.ml"
+# 13734 "parsing/parser.ml"
in
let kind_priv_manifest =
let _1 = _1_inlined4 in
-# 2922 "parsing/parser.mly"
+# 2927 "parsing/parser.mly"
( _2 )
-# 13746 "parsing/parser.ml"
+# 13742 "parsing/parser.ml"
in
let id =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 13757 "parsing/parser.ml"
+# 13753 "parsing/parser.ml"
in
let flag =
let _startpos = _startpos__1_ in
let _loc = (_startpos, _endpos) in
-# 3575 "parsing/parser.mly"
+# 3591 "parsing/parser.mly"
( not_expecting _loc "nonrec flag" )
-# 13768 "parsing/parser.ml"
+# 13764 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 13776 "parsing/parser.ml"
+# 13772 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2859 "parsing/parser.mly"
+# 2864 "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
)
-# 13792 "parsing/parser.ml"
+# 13788 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs : ((Parsetree.core_type * Parsetree.core_type * Ast_helper.loc) list) = Obj.magic xs in
let kind_priv_manifest : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic kind_priv_manifest in
let _1_inlined2 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 13858 "parsing/parser.ml"
+# 13854 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
- let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params 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 ext : (string Asttypes.loc option) = Obj.magic ext in
let _1 : unit = Obj.magic _1 in
Parsetree.type_declaration) = let attrs2 =
let _1 = _1_inlined3 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 13873 "parsing/parser.ml"
+# 13869 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 13882 "parsing/parser.ml"
+# 13878 "parsing/parser.ml"
in
-# 897 "parsing/parser.mly"
+# 901 "parsing/parser.mly"
( xs )
-# 13887 "parsing/parser.ml"
+# 13883 "parsing/parser.ml"
in
-# 2887 "parsing/parser.mly"
+# 2892 "parsing/parser.mly"
( _1 )
-# 13893 "parsing/parser.ml"
+# 13889 "parsing/parser.ml"
in
let id =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 13904 "parsing/parser.ml"
+# 13900 "parsing/parser.ml"
in
let flag =
-# 3570 "parsing/parser.mly"
+# 3586 "parsing/parser.mly"
( Recursive )
-# 13910 "parsing/parser.ml"
+# 13906 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 13917 "parsing/parser.ml"
+# 13913 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2859 "parsing/parser.mly"
+# 2864 "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
)
-# 13933 "parsing/parser.ml"
+# 13929 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs : ((Parsetree.core_type * Parsetree.core_type * Ast_helper.loc) list) = Obj.magic xs in
let kind_priv_manifest : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic kind_priv_manifest in
let _1_inlined3 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 14005 "parsing/parser.ml"
+# 14001 "parsing/parser.ml"
) = Obj.magic _1_inlined3 in
- let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in
+ let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let _1_inlined2 : unit = 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
Parsetree.type_declaration) = let attrs2 =
let _1 = _1_inlined4 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 14021 "parsing/parser.ml"
+# 14017 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 14030 "parsing/parser.ml"
+# 14026 "parsing/parser.ml"
in
-# 897 "parsing/parser.mly"
+# 901 "parsing/parser.mly"
( xs )
-# 14035 "parsing/parser.ml"
+# 14031 "parsing/parser.ml"
in
-# 2887 "parsing/parser.mly"
+# 2892 "parsing/parser.mly"
( _1 )
-# 14041 "parsing/parser.ml"
+# 14037 "parsing/parser.ml"
in
let id =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 14052 "parsing/parser.ml"
+# 14048 "parsing/parser.ml"
in
let flag =
let _1 = _1_inlined2 in
-# 3571 "parsing/parser.mly"
+# 3587 "parsing/parser.mly"
( Nonrecursive )
-# 14060 "parsing/parser.ml"
+# 14056 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 14068 "parsing/parser.ml"
+# 14064 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2859 "parsing/parser.mly"
+# 2864 "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
)
-# 14084 "parsing/parser.ml"
+# 14080 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 697 "parsing/parser.mly"
+# 701 "parsing/parser.mly"
(string)
-# 14105 "parsing/parser.ml"
+# 14101 "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) =
-# 3415 "parsing/parser.mly"
+# 3431 "parsing/parser.mly"
( _1 )
-# 14113 "parsing/parser.ml"
+# 14109 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 14134 "parsing/parser.ml"
+# 14130 "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) =
-# 3416 "parsing/parser.mly"
+# 3432 "parsing/parser.mly"
( _1 )
-# 14142 "parsing/parser.ml"
+# 14138 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (
-# 777 "parsing/parser.mly"
+# 781 "parsing/parser.mly"
(Parsetree.structure)
-# 14174 "parsing/parser.ml"
+# 14170 "parsing/parser.ml"
) =
-# 1068 "parsing/parser.mly"
+# 1072 "parsing/parser.mly"
( _1 )
-# 14178 "parsing/parser.ml"
+# 14174 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (string) =
-# 3465 "parsing/parser.mly"
+# 3481 "parsing/parser.mly"
( "" )
-# 14196 "parsing/parser.ml"
+# 14192 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (string) =
-# 3466 "parsing/parser.mly"
+# 3482 "parsing/parser.mly"
( ";.." )
-# 14228 "parsing/parser.ml"
+# 14224 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (
-# 779 "parsing/parser.mly"
+# 783 "parsing/parser.mly"
(Parsetree.signature)
-# 14260 "parsing/parser.ml"
+# 14256 "parsing/parser.ml"
) =
-# 1074 "parsing/parser.mly"
+# 1078 "parsing/parser.mly"
( _1 )
-# 14264 "parsing/parser.ml"
+# 14260 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (Parsetree.extension) =
-# 3750 "parsing/parser.mly"
+# 3766 "parsing/parser.mly"
( (_2, _3) )
-# 14310 "parsing/parser.ml"
+# 14306 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 689 "parsing/parser.mly"
+# 693 "parsing/parser.mly"
(string * Location.t * string * Location.t * string option)
-# 14331 "parsing/parser.ml"
+# 14327 "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
-# 3752 "parsing/parser.mly"
+# 3768 "parsing/parser.mly"
( mk_quotedext ~loc:_sloc _1 )
-# 14342 "parsing/parser.ml"
+# 14338 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in
let _3 : unit = Obj.magic _3 in
let _1_inlined1 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 14390 "parsing/parser.ml"
+# 14386 "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
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 14401 "parsing/parser.ml"
+# 14397 "parsing/parser.ml"
in
let _endpos__5_ = _endpos__1_inlined3_ in
let _4 =
let _1 = _1_inlined2 in
-# 3168 "parsing/parser.mly"
+# 3184 "parsing/parser.mly"
( _1 )
-# 14410 "parsing/parser.ml"
+# 14406 "parsing/parser.ml"
in
let _2 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3393 "parsing/parser.mly"
+# 3409 "parsing/parser.mly"
( _1 )
-# 14418 "parsing/parser.ml"
+# 14414 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 14426 "parsing/parser.ml"
+# 14422 "parsing/parser.ml"
in
let _startpos__2_ = _startpos__1_inlined1_ in
_startpos__2_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3045 "parsing/parser.mly"
+# 3061 "parsing/parser.mly"
( let info = symbol_info _endpos in
Type.field _2 _4 ~mut:_1 ~attrs:_5 ~loc:(make_loc _sloc) ~info )
-# 14440 "parsing/parser.ml"
+# 14436 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in
let _3 : unit = Obj.magic _3 in
let _1_inlined1 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 14502 "parsing/parser.ml"
+# 14498 "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
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 14513 "parsing/parser.ml"
+# 14509 "parsing/parser.ml"
in
let _endpos__7_ = _endpos__1_inlined4_ in
let _5 =
let _1 = _1_inlined3 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 14522 "parsing/parser.ml"
+# 14518 "parsing/parser.ml"
in
let _endpos__5_ = _endpos__1_inlined3_ in
let _4 =
let _1 = _1_inlined2 in
-# 3168 "parsing/parser.mly"
+# 3184 "parsing/parser.mly"
( _1 )
-# 14531 "parsing/parser.ml"
+# 14527 "parsing/parser.ml"
in
let _2 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3393 "parsing/parser.mly"
+# 3409 "parsing/parser.mly"
( _1 )
-# 14539 "parsing/parser.ml"
+# 14535 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 14547 "parsing/parser.ml"
+# 14543 "parsing/parser.ml"
in
let _startpos__2_ = _startpos__1_inlined1_ in
_startpos__2_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3050 "parsing/parser.mly"
+# 3066 "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 )
-# 14565 "parsing/parser.ml"
+# 14561 "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) =
-# 3039 "parsing/parser.mly"
+# 3055 "parsing/parser.mly"
( [_1] )
-# 14590 "parsing/parser.ml"
+# 14586 "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) =
-# 3040 "parsing/parser.mly"
+# 3056 "parsing/parser.mly"
( [_1] )
-# 14615 "parsing/parser.ml"
+# 14611 "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) =
-# 3041 "parsing/parser.mly"
+# 3057 "parsing/parser.mly"
( _1 :: _2 )
-# 14647 "parsing/parser.ml"
+# 14643 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 14668 "parsing/parser.ml"
+# 14664 "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
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 14681 "parsing/parser.ml"
+# 14677 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2123 "parsing/parser.mly"
+# 2129 "parsing/parser.mly"
( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) )
-# 14690 "parsing/parser.ml"
+# 14686 "parsing/parser.ml"
in
-# 2115 "parsing/parser.mly"
+# 2121 "parsing/parser.mly"
( x )
-# 14696 "parsing/parser.ml"
+# 14692 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let cty : (Parsetree.core_type) = Obj.magic cty in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 14731 "parsing/parser.ml"
+# 14727 "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
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 14744 "parsing/parser.ml"
+# 14740 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2123 "parsing/parser.mly"
+# 2129 "parsing/parser.mly"
( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) )
-# 14753 "parsing/parser.ml"
+# 14749 "parsing/parser.ml"
in
let _startpos_x_ = _startpos__1_ in
let _symbolstartpos = _startpos_x_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2117 "parsing/parser.mly"
+# 2123 "parsing/parser.mly"
( let lab, pat = x in
lab,
mkpat ~loc:_sloc (Ppat_constraint (pat, cty)) )
-# 14765 "parsing/parser.ml"
+# 14761 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3497 "parsing/parser.mly"
+# 3513 "parsing/parser.mly"
( _1 )
-# 14790 "parsing/parser.ml"
+# 14786 "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) =
-# 2400 "parsing/parser.mly"
+# 2402 "parsing/parser.mly"
( (Nolabel, _1) )
-# 14815 "parsing/parser.ml"
+# 14811 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let _2 : (Parsetree.expression) = Obj.magic _2 in
let _1 : (
-# 634 "parsing/parser.mly"
+# 638 "parsing/parser.mly"
(string)
-# 14843 "parsing/parser.ml"
+# 14839 "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) =
-# 2402 "parsing/parser.mly"
+# 2404 "parsing/parser.mly"
( (Labelled _1, _2) )
-# 14851 "parsing/parser.ml"
+# 14847 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let label : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 14878 "parsing/parser.ml"
+# 14874 "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
-# 2404 "parsing/parser.mly"
+# 2406 "parsing/parser.mly"
( let loc = _loc_label_ in
(Labelled label, mkexpvar ~loc label) )
-# 14889 "parsing/parser.ml"
+# 14885 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let label : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 14916 "parsing/parser.ml"
+# 14912 "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
-# 2407 "parsing/parser.mly"
+# 2409 "parsing/parser.mly"
( let loc = _loc_label_ in
(Optional label, mkexpvar ~loc label) )
-# 14927 "parsing/parser.ml"
+# 14923 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let _2 : (Parsetree.expression) = Obj.magic _2 in
let _1 : (
-# 664 "parsing/parser.mly"
+# 668 "parsing/parser.mly"
(string)
-# 14955 "parsing/parser.ml"
+# 14951 "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) =
-# 2410 "parsing/parser.mly"
+# 2412 "parsing/parser.mly"
( (Optional _1, _2) )
-# 14963 "parsing/parser.ml"
+# 14959 "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
-# 2111 "parsing/parser.mly"
+# 2117 "parsing/parser.mly"
( _1 )
-# 15018 "parsing/parser.ml"
+# 15014 "parsing/parser.ml"
in
-# 2085 "parsing/parser.mly"
+# 2091 "parsing/parser.mly"
( (Optional (fst _3), _4, snd _3) )
-# 15024 "parsing/parser.ml"
+# 15020 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _1_inlined1 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 15051 "parsing/parser.ml"
+# 15047 "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
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 15066 "parsing/parser.ml"
+# 15062 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2123 "parsing/parser.mly"
+# 2129 "parsing/parser.mly"
( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) )
-# 15075 "parsing/parser.ml"
+# 15071 "parsing/parser.ml"
in
-# 2087 "parsing/parser.mly"
+# 2093 "parsing/parser.mly"
( (Optional (fst _2), None, snd _2) )
-# 15081 "parsing/parser.ml"
+# 15077 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 : (Parsetree.pattern) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 664 "parsing/parser.mly"
+# 668 "parsing/parser.mly"
(string)
-# 15130 "parsing/parser.ml"
+# 15126 "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
-# 2111 "parsing/parser.mly"
+# 2117 "parsing/parser.mly"
( _1 )
-# 15140 "parsing/parser.ml"
+# 15136 "parsing/parser.ml"
in
-# 2089 "parsing/parser.mly"
+# 2095 "parsing/parser.mly"
( (Optional _1, _4, _3) )
-# 15146 "parsing/parser.ml"
+# 15142 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let _2 : (Parsetree.pattern) = Obj.magic _2 in
let _1 : (
-# 664 "parsing/parser.mly"
+# 668 "parsing/parser.mly"
(string)
-# 15174 "parsing/parser.ml"
+# 15170 "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) =
-# 2091 "parsing/parser.mly"
+# 2097 "parsing/parser.mly"
( (Optional _1, None, _2) )
-# 15182 "parsing/parser.ml"
+# 15178 "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) =
-# 2093 "parsing/parser.mly"
+# 2099 "parsing/parser.mly"
( (Labelled (fst _3), None, snd _3) )
-# 15228 "parsing/parser.ml"
+# 15224 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _1_inlined1 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 15255 "parsing/parser.ml"
+# 15251 "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
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 15270 "parsing/parser.ml"
+# 15266 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2123 "parsing/parser.mly"
+# 2129 "parsing/parser.mly"
( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) )
-# 15279 "parsing/parser.ml"
+# 15275 "parsing/parser.ml"
in
-# 2095 "parsing/parser.mly"
+# 2101 "parsing/parser.mly"
( (Labelled (fst _2), None, snd _2) )
-# 15285 "parsing/parser.ml"
+# 15281 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let _2 : (Parsetree.pattern) = Obj.magic _2 in
let _1 : (
-# 634 "parsing/parser.mly"
+# 638 "parsing/parser.mly"
(string)
-# 15313 "parsing/parser.ml"
+# 15309 "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) =
-# 2097 "parsing/parser.mly"
+# 2103 "parsing/parser.mly"
( (Labelled _1, None, _2) )
-# 15321 "parsing/parser.ml"
+# 15317 "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) =
-# 2099 "parsing/parser.mly"
+# 2105 "parsing/parser.mly"
( (Nolabel, None, _1) )
-# 15346 "parsing/parser.ml"
+# 15342 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2417 "parsing/parser.mly"
+# 2419 "parsing/parser.mly"
( mkpatvar ~loc:_sloc _1 )
-# 15382 "parsing/parser.ml"
+# 15378 "parsing/parser.ml"
in
-# 2421 "parsing/parser.mly"
+# 2423 "parsing/parser.mly"
( (_1, _2) )
-# 15388 "parsing/parser.ml"
+# 15384 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2417 "parsing/parser.mly"
+# 2419 "parsing/parser.mly"
( mkpatvar ~loc:_sloc _1 )
-# 15438 "parsing/parser.ml"
+# 15434 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2423 "parsing/parser.mly"
+# 2425 "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) )
-# 15458 "parsing/parser.ml"
+# 15454 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 15527 "parsing/parser.ml"
+# 15523 "parsing/parser.ml"
in
-# 915 "parsing/parser.mly"
+# 919 "parsing/parser.mly"
( xs )
-# 15532 "parsing/parser.ml"
+# 15528 "parsing/parser.ml"
in
-# 3150 "parsing/parser.mly"
+# 3166 "parsing/parser.mly"
( _1 )
-# 15538 "parsing/parser.ml"
+# 15534 "parsing/parser.ml"
in
let _startpos__3_ = _startpos_xs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2417 "parsing/parser.mly"
+# 2419 "parsing/parser.mly"
( mkpatvar ~loc:_sloc _1 )
-# 15549 "parsing/parser.ml"
+# 15545 "parsing/parser.ml"
in
-# 2439 "parsing/parser.mly"
+# 2441 "parsing/parser.mly"
( let typloc = (_startpos__3_, _endpos__5_) in
let patloc = (_startpos__1_, _endpos__5_) in
(ghpat ~loc:patloc
(Ppat_constraint(_1, ghtyp ~loc:typloc (Ptyp_poly(_3,_5)))),
_7) )
-# 15559 "parsing/parser.ml"
+# 15555 "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 =
-# 2414 "parsing/parser.mly"
+# 2416 "parsing/parser.mly"
( xs )
-# 15633 "parsing/parser.ml"
+# 15629 "parsing/parser.ml"
in
let _1 =
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2417 "parsing/parser.mly"
+# 2419 "parsing/parser.mly"
( mkpatvar ~loc:_sloc _1 )
-# 15642 "parsing/parser.ml"
+# 15638 "parsing/parser.ml"
in
let _endpos = _endpos__8_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2445 "parsing/parser.mly"
+# 2447 "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) )
-# 15654 "parsing/parser.ml"
+# 15650 "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) =
-# 2450 "parsing/parser.mly"
+# 2452 "parsing/parser.mly"
( (_1, _3) )
-# 15693 "parsing/parser.ml"
+# 15689 "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) =
-# 2452 "parsing/parser.mly"
+# 2454 "parsing/parser.mly"
( let loc = (_startpos__1_, _endpos__3_) in
(ghpat ~loc (Ppat_constraint(_1, _3)), _5) )
-# 15747 "parsing/parser.ml"
+# 15743 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined2 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 15810 "parsing/parser.ml"
+# 15806 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined2_ in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 15819 "parsing/parser.ml"
+# 15815 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2468 "parsing/parser.mly"
+# 2470 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
mklbs ~loc:_sloc ext rec_flag (mklb ~loc:_sloc true body attrs)
)
-# 15831 "parsing/parser.ml"
+# 15827 "parsing/parser.ml"
in
-# 2458 "parsing/parser.mly"
+# 2460 "parsing/parser.mly"
( _1 )
-# 15837 "parsing/parser.ml"
+# 15833 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (let_bindings) =
-# 2459 "parsing/parser.mly"
+# 2461 "parsing/parser.mly"
( addlb _1 _2 )
-# 15869 "parsing/parser.ml"
+# 15865 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined2 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 15925 "parsing/parser.ml"
+# 15921 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined2_ in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 15934 "parsing/parser.ml"
+# 15930 "parsing/parser.ml"
in
let ext =
-# 3738 "parsing/parser.mly"
+# 3754 "parsing/parser.mly"
( None )
-# 15940 "parsing/parser.ml"
+# 15936 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2468 "parsing/parser.mly"
+# 2470 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
mklbs ~loc:_sloc ext rec_flag (mklb ~loc:_sloc true body attrs)
)
-# 15951 "parsing/parser.ml"
+# 15947 "parsing/parser.ml"
in
-# 2458 "parsing/parser.mly"
+# 2460 "parsing/parser.mly"
( _1 )
-# 15957 "parsing/parser.ml"
+# 15953 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined3 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 16027 "parsing/parser.ml"
+# 16023 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let attrs1 =
let _1 = _1_inlined2 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 16036 "parsing/parser.ml"
+# 16032 "parsing/parser.ml"
in
let ext =
let _startpos = _startpos__1_ in
let _loc = (_startpos, _endpos) in
-# 3739 "parsing/parser.mly"
+# 3755 "parsing/parser.mly"
( not_expecting _loc "extension" )
-# 16047 "parsing/parser.ml"
+# 16043 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2468 "parsing/parser.mly"
+# 2470 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
mklbs ~loc:_sloc ext rec_flag (mklb ~loc:_sloc true body attrs)
)
-# 16059 "parsing/parser.ml"
+# 16055 "parsing/parser.ml"
in
-# 2458 "parsing/parser.mly"
+# 2460 "parsing/parser.mly"
( _1 )
-# 16065 "parsing/parser.ml"
+# 16061 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (let_bindings) =
-# 2459 "parsing/parser.mly"
+# 2461 "parsing/parser.mly"
( addlb _1 _2 )
-# 16097 "parsing/parser.ml"
+# 16093 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) =
-# 2127 "parsing/parser.mly"
+# 2133 "parsing/parser.mly"
( _1 )
-# 16122 "parsing/parser.ml"
+# 16118 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2129 "parsing/parser.mly"
+# 2135 "parsing/parser.mly"
( Ppat_constraint(_1, _3) )
-# 16162 "parsing/parser.ml"
+# 16158 "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
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 16171 "parsing/parser.ml"
+# 16167 "parsing/parser.ml"
in
-# 2130 "parsing/parser.mly"
+# 2136 "parsing/parser.mly"
( _1 )
-# 16177 "parsing/parser.ml"
+# 16173 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2417 "parsing/parser.mly"
+# 2419 "parsing/parser.mly"
( mkpatvar ~loc:_sloc _1 )
-# 16213 "parsing/parser.ml"
+# 16209 "parsing/parser.ml"
in
-# 2485 "parsing/parser.mly"
+# 2487 "parsing/parser.mly"
( (pat, exp) )
-# 16219 "parsing/parser.ml"
+# 16215 "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) =
-# 2487 "parsing/parser.mly"
+# 2489 "parsing/parser.mly"
( let loc = (_startpos_pat_, _endpos_typ_) in
(ghpat ~loc (Ppat_constraint(pat, typ)), exp) )
-# 16273 "parsing/parser.ml"
+# 16269 "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) =
-# 2490 "parsing/parser.mly"
+# 2492 "parsing/parser.mly"
( (pat, exp) )
-# 16312 "parsing/parser.ml"
+# 16308 "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) =
-# 2494 "parsing/parser.mly"
+# 2496 "parsing/parser.mly"
( let let_pat, let_exp = body in
let_pat, let_exp, [] )
-# 16338 "parsing/parser.ml"
+# 16334 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let body : (Parsetree.pattern * Parsetree.expression) = Obj.magic body in
let _1 : (
-# 630 "parsing/parser.mly"
+# 634 "parsing/parser.mly"
(string)
-# 16372 "parsing/parser.ml"
+# 16368 "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
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 16385 "parsing/parser.ml"
+# 16381 "parsing/parser.ml"
in
let _endpos = _endpos_body_ in
let _symbolstartpos = _startpos_bindings_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2497 "parsing/parser.mly"
+# 2499 "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 )
-# 16398 "parsing/parser.ml"
+# 16394 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_declaration list) =
# 211 "<standard.mly>"
( [] )
-# 16416 "parsing/parser.ml"
+# 16412 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
let body : (Parsetree.class_expr) = Obj.magic body in
let _1_inlined2 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 16482 "parsing/parser.ml"
+# 16478 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
- let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params 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 _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
let attrs2 =
let _1 = _1_inlined3 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 16497 "parsing/parser.ml"
+# 16493 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 16509 "parsing/parser.ml"
+# 16505 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 16517 "parsing/parser.ml"
+# 16513 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1731 "parsing/parser.mly"
+# 1737 "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
)
-# 16532 "parsing/parser.ml"
+# 16528 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 16538 "parsing/parser.ml"
+# 16534 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_description list) =
# 211 "<standard.mly>"
( [] )
-# 16556 "parsing/parser.ml"
+# 16552 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let cty : (Parsetree.class_type) = Obj.magic cty in
let _6 : unit = Obj.magic _6 in
let _1_inlined2 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 16629 "parsing/parser.ml"
+# 16625 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
- let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params 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 _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
let attrs2 =
let _1 = _1_inlined3 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 16644 "parsing/parser.ml"
+# 16640 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 16656 "parsing/parser.ml"
+# 16652 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 16664 "parsing/parser.ml"
+# 16660 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2022 "parsing/parser.mly"
+# 2028 "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
)
-# 16679 "parsing/parser.ml"
+# 16675 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 16685 "parsing/parser.ml"
+# 16681 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_type_declaration list) =
# 211 "<standard.mly>"
( [] )
-# 16703 "parsing/parser.ml"
+# 16699 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let csig : (Parsetree.class_type) = Obj.magic csig in
let _6 : unit = Obj.magic _6 in
let _1_inlined2 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 16776 "parsing/parser.ml"
+# 16772 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
- let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params 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 _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
let attrs2 =
let _1 = _1_inlined3 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 16791 "parsing/parser.ml"
+# 16787 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 16803 "parsing/parser.ml"
+# 16799 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 16811 "parsing/parser.ml"
+# 16807 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2061 "parsing/parser.mly"
+# 2067 "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
)
-# 16826 "parsing/parser.ml"
+# 16822 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 16832 "parsing/parser.ml"
+# 16828 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_binding list) =
# 211 "<standard.mly>"
( [] )
-# 16850 "parsing/parser.ml"
+# 16846 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined3 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 16913 "parsing/parser.ml"
+# 16909 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 16925 "parsing/parser.ml"
+# 16921 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 16933 "parsing/parser.ml"
+# 16929 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1413 "parsing/parser.mly"
+# 1418 "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
)
-# 16948 "parsing/parser.ml"
+# 16944 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 16954 "parsing/parser.ml"
+# 16950 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_declaration list) =
# 211 "<standard.mly>"
( [] )
-# 16972 "parsing/parser.ml"
+# 16968 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined3 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 17042 "parsing/parser.ml"
+# 17038 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 17054 "parsing/parser.ml"
+# 17050 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 17062 "parsing/parser.ml"
+# 17058 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1689 "parsing/parser.mly"
+# 1695 "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
)
-# 17077 "parsing/parser.ml"
+# 17073 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 17083 "parsing/parser.ml"
+# 17079 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.attributes) =
# 211 "<standard.mly>"
( [] )
-# 17101 "parsing/parser.ml"
+# 17097 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.attributes) =
# 213 "<standard.mly>"
( x :: xs )
-# 17133 "parsing/parser.ml"
+# 17129 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.type_declaration list) =
# 211 "<standard.mly>"
( [] )
-# 17151 "parsing/parser.ml"
+# 17147 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs_inlined1 : ((Parsetree.core_type * Parsetree.core_type * Ast_helper.loc) list) = Obj.magic xs_inlined1 in
let kind_priv_manifest : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic kind_priv_manifest in
let _1_inlined2 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 17218 "parsing/parser.ml"
+# 17214 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
- let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params 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 _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let attrs2 =
let _1 = _1_inlined3 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 17233 "parsing/parser.ml"
+# 17229 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 17242 "parsing/parser.ml"
+# 17238 "parsing/parser.ml"
in
-# 897 "parsing/parser.mly"
+# 901 "parsing/parser.mly"
( xs )
-# 17247 "parsing/parser.ml"
+# 17243 "parsing/parser.ml"
in
-# 2887 "parsing/parser.mly"
+# 2892 "parsing/parser.mly"
( _1 )
-# 17253 "parsing/parser.ml"
+# 17249 "parsing/parser.ml"
in
let id =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 17264 "parsing/parser.ml"
+# 17260 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 17272 "parsing/parser.ml"
+# 17268 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2876 "parsing/parser.mly"
+# 2881 "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
)
-# 17288 "parsing/parser.ml"
+# 17284 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 17294 "parsing/parser.ml"
+# 17290 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.type_declaration list) =
# 211 "<standard.mly>"
( [] )
-# 17312 "parsing/parser.ml"
+# 17308 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic _2 in
let _1_inlined3 : unit = Obj.magic _1_inlined3 in
let _1_inlined2 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 17386 "parsing/parser.ml"
+# 17382 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
- let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params 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 _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let attrs2 =
let _1 = _1_inlined4 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 17401 "parsing/parser.ml"
+# 17397 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 17410 "parsing/parser.ml"
+# 17406 "parsing/parser.ml"
in
-# 897 "parsing/parser.mly"
+# 901 "parsing/parser.mly"
( xs )
-# 17415 "parsing/parser.ml"
+# 17411 "parsing/parser.ml"
in
-# 2887 "parsing/parser.mly"
+# 2892 "parsing/parser.mly"
( _1 )
-# 17421 "parsing/parser.ml"
+# 17417 "parsing/parser.ml"
in
let kind_priv_manifest =
let _1 = _1_inlined3 in
-# 2922 "parsing/parser.mly"
+# 2927 "parsing/parser.mly"
( _2 )
-# 17429 "parsing/parser.ml"
+# 17425 "parsing/parser.ml"
in
let id =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 17440 "parsing/parser.ml"
+# 17436 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 17448 "parsing/parser.ml"
+# 17444 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2876 "parsing/parser.mly"
+# 2881 "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
)
-# 17464 "parsing/parser.ml"
+# 17460 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 17470 "parsing/parser.ml"
+# 17466 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.attributes) =
# 211 "<standard.mly>"
( [] )
-# 17488 "parsing/parser.ml"
+# 17484 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.attributes) =
# 213 "<standard.mly>"
( x :: xs )
-# 17520 "parsing/parser.ml"
+# 17516 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.signature_item list list) =
# 211 "<standard.mly>"
( [] )
-# 17538 "parsing/parser.ml"
+# 17534 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _startpos = _startpos__1_ in
-# 823 "parsing/parser.mly"
+# 827 "parsing/parser.mly"
( text_sig _startpos )
-# 17573 "parsing/parser.ml"
+# 17569 "parsing/parser.ml"
in
-# 1551 "parsing/parser.mly"
+# 1556 "parsing/parser.mly"
( _1 )
-# 17579 "parsing/parser.ml"
+# 17575 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 17585 "parsing/parser.ml"
+# 17581 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _startpos = _startpos__1_ in
-# 821 "parsing/parser.mly"
+# 825 "parsing/parser.mly"
( text_sig _startpos @ [_1] )
-# 17620 "parsing/parser.ml"
+# 17616 "parsing/parser.ml"
in
-# 1551 "parsing/parser.mly"
+# 1556 "parsing/parser.mly"
( _1 )
-# 17626 "parsing/parser.ml"
+# 17622 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 17632 "parsing/parser.ml"
+# 17628 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.structure_item list list) =
# 211 "<standard.mly>"
( [] )
-# 17650 "parsing/parser.ml"
+# 17646 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let ys =
let items =
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( [] )
-# 17685 "parsing/parser.ml"
+# 17681 "parsing/parser.ml"
in
-# 1297 "parsing/parser.mly"
+# 1301 "parsing/parser.mly"
( items )
-# 17690 "parsing/parser.ml"
+# 17686 "parsing/parser.ml"
in
let xs =
let _startpos = _startpos__1_ in
-# 819 "parsing/parser.mly"
+# 823 "parsing/parser.mly"
( text_str _startpos )
-# 17698 "parsing/parser.ml"
+# 17694 "parsing/parser.ml"
in
# 267 "<standard.mly>"
( xs @ ys )
-# 17704 "parsing/parser.ml"
+# 17700 "parsing/parser.ml"
in
-# 1313 "parsing/parser.mly"
+# 1317 "parsing/parser.mly"
( _1 )
-# 17710 "parsing/parser.ml"
+# 17706 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 17716 "parsing/parser.ml"
+# 17712 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _1 =
let attrs =
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 17770 "parsing/parser.ml"
+# 17766 "parsing/parser.ml"
in
-# 1304 "parsing/parser.mly"
+# 1308 "parsing/parser.mly"
( mkstrexp e attrs )
-# 17775 "parsing/parser.ml"
+# 17771 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_e_ in
let _startpos = _startpos__1_ in
-# 817 "parsing/parser.mly"
+# 821 "parsing/parser.mly"
( text_str _startpos @ [_1] )
-# 17783 "parsing/parser.ml"
+# 17779 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_e_ in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 836 "parsing/parser.mly"
+# 840 "parsing/parser.mly"
( mark_rhs_docs _startpos _endpos;
_1 )
-# 17793 "parsing/parser.ml"
+# 17789 "parsing/parser.ml"
in
-# 885 "parsing/parser.mly"
+# 889 "parsing/parser.mly"
( x )
-# 17799 "parsing/parser.ml"
+# 17795 "parsing/parser.ml"
in
-# 1297 "parsing/parser.mly"
+# 1301 "parsing/parser.mly"
( items )
-# 17805 "parsing/parser.ml"
+# 17801 "parsing/parser.ml"
in
let xs =
let _startpos = _startpos__1_ in
-# 819 "parsing/parser.mly"
+# 823 "parsing/parser.mly"
( text_str _startpos )
-# 17813 "parsing/parser.ml"
+# 17809 "parsing/parser.ml"
in
# 267 "<standard.mly>"
( xs @ ys )
-# 17819 "parsing/parser.ml"
+# 17815 "parsing/parser.ml"
in
-# 1313 "parsing/parser.mly"
+# 1317 "parsing/parser.mly"
( _1 )
-# 17825 "parsing/parser.ml"
+# 17821 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 17831 "parsing/parser.ml"
+# 17827 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _startpos = _startpos__1_ in
-# 817 "parsing/parser.mly"
+# 821 "parsing/parser.mly"
( text_str _startpos @ [_1] )
-# 17866 "parsing/parser.ml"
+# 17862 "parsing/parser.ml"
in
-# 1313 "parsing/parser.mly"
+# 1317 "parsing/parser.mly"
( _1 )
-# 17872 "parsing/parser.ml"
+# 17868 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 17878 "parsing/parser.ml"
+# 17874 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_type_field list list) =
# 211 "<standard.mly>"
( [] )
-# 17896 "parsing/parser.ml"
+# 17892 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_type_field list list) = let x =
let _startpos = _startpos__1_ in
-# 831 "parsing/parser.mly"
+# 835 "parsing/parser.mly"
( text_csig _startpos @ [_1] )
-# 17930 "parsing/parser.ml"
+# 17926 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 17936 "parsing/parser.ml"
+# 17932 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field list list) =
# 211 "<standard.mly>"
( [] )
-# 17954 "parsing/parser.ml"
+# 17950 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field list list) = let x =
let _startpos = _startpos__1_ in
-# 829 "parsing/parser.mly"
+# 833 "parsing/parser.mly"
( text_cstr _startpos @ [_1] )
-# 17988 "parsing/parser.ml"
+# 17984 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 17994 "parsing/parser.ml"
+# 17990 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.structure_item list list) =
# 211 "<standard.mly>"
( [] )
-# 18012 "parsing/parser.ml"
+# 18008 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.structure_item list list) = let x =
let _startpos = _startpos__1_ in
-# 817 "parsing/parser.mly"
+# 821 "parsing/parser.mly"
( text_str _startpos @ [_1] )
-# 18046 "parsing/parser.ml"
+# 18042 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 18052 "parsing/parser.ml"
+# 18048 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.toplevel_phrase list list) =
# 211 "<standard.mly>"
( [] )
-# 18070 "parsing/parser.ml"
+# 18066 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let x =
let _1 =
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( [] )
-# 18105 "parsing/parser.ml"
+# 18101 "parsing/parser.ml"
in
-# 1113 "parsing/parser.mly"
+# 1117 "parsing/parser.mly"
( _1 )
-# 18110 "parsing/parser.ml"
+# 18106 "parsing/parser.ml"
in
# 183 "<standard.mly>"
( x )
-# 18116 "parsing/parser.ml"
+# 18112 "parsing/parser.ml"
in
-# 1125 "parsing/parser.mly"
+# 1129 "parsing/parser.mly"
( _1 )
-# 18122 "parsing/parser.ml"
+# 18118 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 18128 "parsing/parser.ml"
+# 18124 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _1 =
let attrs =
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 18182 "parsing/parser.ml"
+# 18178 "parsing/parser.ml"
in
-# 1304 "parsing/parser.mly"
+# 1308 "parsing/parser.mly"
( mkstrexp e attrs )
-# 18187 "parsing/parser.ml"
+# 18183 "parsing/parser.ml"
in
-# 827 "parsing/parser.mly"
+# 831 "parsing/parser.mly"
( Ptop_def [_1] )
-# 18193 "parsing/parser.ml"
+# 18189 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_e_ in
let _startpos = _startpos__1_ in
-# 825 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( text_def _startpos @ [_1] )
-# 18201 "parsing/parser.ml"
+# 18197 "parsing/parser.ml"
in
-# 885 "parsing/parser.mly"
+# 889 "parsing/parser.mly"
( x )
-# 18207 "parsing/parser.ml"
+# 18203 "parsing/parser.ml"
in
-# 1113 "parsing/parser.mly"
+# 1117 "parsing/parser.mly"
( _1 )
-# 18213 "parsing/parser.ml"
+# 18209 "parsing/parser.ml"
in
# 183 "<standard.mly>"
( x )
-# 18219 "parsing/parser.ml"
+# 18215 "parsing/parser.ml"
in
-# 1125 "parsing/parser.mly"
+# 1129 "parsing/parser.mly"
( _1 )
-# 18225 "parsing/parser.ml"
+# 18221 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 18231 "parsing/parser.ml"
+# 18227 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.toplevel_phrase list list) = let x =
let _1 =
let _1 =
-# 827 "parsing/parser.mly"
+# 831 "parsing/parser.mly"
( Ptop_def [_1] )
-# 18265 "parsing/parser.ml"
+# 18261 "parsing/parser.ml"
in
let _startpos = _startpos__1_ in
-# 825 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( text_def _startpos @ [_1] )
-# 18271 "parsing/parser.ml"
+# 18267 "parsing/parser.ml"
in
-# 1125 "parsing/parser.mly"
+# 1129 "parsing/parser.mly"
( _1 )
-# 18277 "parsing/parser.ml"
+# 18273 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 18283 "parsing/parser.ml"
+# 18279 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 836 "parsing/parser.mly"
+# 840 "parsing/parser.mly"
( mark_rhs_docs _startpos _endpos;
_1 )
-# 18321 "parsing/parser.ml"
+# 18317 "parsing/parser.ml"
in
let _startpos = _startpos__1_ in
-# 825 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( text_def _startpos @ [_1] )
-# 18328 "parsing/parser.ml"
+# 18324 "parsing/parser.ml"
in
-# 1125 "parsing/parser.mly"
+# 1129 "parsing/parser.mly"
( _1 )
-# 18334 "parsing/parser.ml"
+# 18330 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 18340 "parsing/parser.ml"
+# 18336 "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 )
-# 18379 "parsing/parser.ml"
+# 18375 "parsing/parser.ml"
in
let x =
let label =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 18389 "parsing/parser.ml"
+# 18385 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2765 "parsing/parser.mly"
- ( let pat =
+# 2767 "parsing/parser.mly"
+ ( let label, pat =
match opat with
| None ->
- (* No pattern; this is a pun. Desugar it. *)
- pat_of_label ~loc:_sloc label
+ (* 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
| Some pat ->
- pat
+ label, pat
in
label, mkpat_opt_constraint ~loc:_sloc pat octy
)
-# 18408 "parsing/parser.ml"
+# 18407 "parsing/parser.ml"
in
-# 1052 "parsing/parser.mly"
+# 1056 "parsing/parser.mly"
( [x], None )
-# 18414 "parsing/parser.ml"
+# 18413 "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 )
-# 18460 "parsing/parser.ml"
+# 18459 "parsing/parser.ml"
in
let x =
let label =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 18470 "parsing/parser.ml"
+# 18469 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2765 "parsing/parser.mly"
- ( let pat =
+# 2767 "parsing/parser.mly"
+ ( let label, pat =
match opat with
| None ->
- (* No pattern; this is a pun. Desugar it. *)
- pat_of_label ~loc:_sloc label
+ (* 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
| Some pat ->
- pat
+ label, pat
in
label, mkpat_opt_constraint ~loc:_sloc pat octy
)
-# 18489 "parsing/parser.ml"
+# 18491 "parsing/parser.ml"
in
-# 1052 "parsing/parser.mly"
+# 1056 "parsing/parser.mly"
( [x], None )
-# 18495 "parsing/parser.ml"
+# 18497 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 18560 "parsing/parser.ml"
+# 18562 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2765 "parsing/parser.mly"
- ( let pat =
+# 2767 "parsing/parser.mly"
+ ( let label, pat =
match opat with
| None ->
- (* No pattern; this is a pun. Desugar it. *)
- pat_of_label ~loc:_sloc label
+ (* 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
| Some pat ->
- pat
+ label, pat
in
label, mkpat_opt_constraint ~loc:_sloc pat octy
)
-# 18579 "parsing/parser.ml"
+# 18584 "parsing/parser.ml"
in
-# 1054 "parsing/parser.mly"
+# 1058 "parsing/parser.mly"
( [x], Some y )
-# 18585 "parsing/parser.ml"
+# 18590 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 18643 "parsing/parser.ml"
+# 18648 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2765 "parsing/parser.mly"
- ( let pat =
+# 2767 "parsing/parser.mly"
+ ( let label, pat =
match opat with
| None ->
- (* No pattern; this is a pun. Desugar it. *)
- pat_of_label ~loc:_sloc label
+ (* 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
| Some pat ->
- pat
+ label, pat
in
label, mkpat_opt_constraint ~loc:_sloc pat octy
)
-# 18662 "parsing/parser.ml"
+# 18670 "parsing/parser.ml"
in
-# 1058 "parsing/parser.mly"
+# 1062 "parsing/parser.mly"
( let xs, y = tail in
x :: xs, y )
-# 18669 "parsing/parser.ml"
+# 18677 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.case) =
-# 2523 "parsing/parser.mly"
+# 2525 "parsing/parser.mly"
( Exp.case _1 _3 )
-# 18708 "parsing/parser.ml"
+# 18716 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.case) =
-# 2525 "parsing/parser.mly"
+# 2527 "parsing/parser.mly"
( Exp.case _1 ~guard:_3 _5 )
-# 18761 "parsing/parser.ml"
+# 18769 "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
-# 2527 "parsing/parser.mly"
+# 2529 "parsing/parser.mly"
( Exp.case _1 (Exp.unreachable ~loc:(make_loc _loc__3_) ()) )
-# 18801 "parsing/parser.ml"
+# 18809 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined1 : (Parsetree.core_type) = Obj.magic _1_inlined1 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 18864 "parsing/parser.ml"
+# 18872 "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
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 18875 "parsing/parser.ml"
+# 18883 "parsing/parser.ml"
in
let _endpos__6_ = _endpos__1_inlined3_ in
let _4 =
let _1 = _1_inlined2 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 18884 "parsing/parser.ml"
+# 18892 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _3 =
let _1 = _1_inlined1 in
-# 3168 "parsing/parser.mly"
+# 3184 "parsing/parser.mly"
( _1 )
-# 18893 "parsing/parser.ml"
+# 18901 "parsing/parser.ml"
in
let _1 =
let _1 =
-# 3393 "parsing/parser.mly"
+# 3409 "parsing/parser.mly"
( _1 )
-# 18900 "parsing/parser.ml"
+# 18908 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 18908 "parsing/parser.ml"
+# 18916 "parsing/parser.ml"
in
let _endpos = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3378 "parsing/parser.mly"
+# 3394 "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 )
-# 18923 "parsing/parser.ml"
+# 18931 "parsing/parser.ml"
in
-# 3359 "parsing/parser.mly"
+# 3375 "parsing/parser.mly"
( let (f, c) = tail in (head :: f, c) )
-# 18929 "parsing/parser.ml"
+# 18937 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos_ty_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3389 "parsing/parser.mly"
+# 3405 "parsing/parser.mly"
( Of.inherit_ ~loc:(make_loc _sloc) ty )
-# 18972 "parsing/parser.ml"
+# 18980 "parsing/parser.ml"
in
-# 3359 "parsing/parser.mly"
+# 3375 "parsing/parser.mly"
( let (f, c) = tail in (head :: f, c) )
-# 18978 "parsing/parser.ml"
+# 18986 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined1 : (Parsetree.core_type) = Obj.magic _1_inlined1 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 19034 "parsing/parser.ml"
+# 19042 "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
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 19045 "parsing/parser.ml"
+# 19053 "parsing/parser.ml"
in
let _endpos__6_ = _endpos__1_inlined3_ in
let _4 =
let _1 = _1_inlined2 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 19054 "parsing/parser.ml"
+# 19062 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _3 =
let _1 = _1_inlined1 in
-# 3168 "parsing/parser.mly"
+# 3184 "parsing/parser.mly"
( _1 )
-# 19063 "parsing/parser.ml"
+# 19071 "parsing/parser.ml"
in
let _1 =
let _1 =
-# 3393 "parsing/parser.mly"
+# 3409 "parsing/parser.mly"
( _1 )
-# 19070 "parsing/parser.ml"
+# 19078 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 19078 "parsing/parser.ml"
+# 19086 "parsing/parser.ml"
in
let _endpos = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3378 "parsing/parser.mly"
+# 3394 "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 )
-# 19093 "parsing/parser.ml"
+# 19101 "parsing/parser.ml"
in
-# 3362 "parsing/parser.mly"
+# 3378 "parsing/parser.mly"
( [head], Closed )
-# 19099 "parsing/parser.ml"
+# 19107 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos_ty_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3389 "parsing/parser.mly"
+# 3405 "parsing/parser.mly"
( Of.inherit_ ~loc:(make_loc _sloc) ty )
-# 19135 "parsing/parser.ml"
+# 19143 "parsing/parser.ml"
in
-# 3362 "parsing/parser.mly"
+# 3378 "parsing/parser.mly"
( [head], Closed )
-# 19141 "parsing/parser.ml"
+# 19149 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined1 : (Parsetree.core_type) = Obj.magic _1_inlined1 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 19183 "parsing/parser.ml"
+# 19191 "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
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 19194 "parsing/parser.ml"
+# 19202 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _3 =
let _1 = _1_inlined1 in
-# 3168 "parsing/parser.mly"
+# 3184 "parsing/parser.mly"
( _1 )
-# 19203 "parsing/parser.ml"
+# 19211 "parsing/parser.ml"
in
let _1 =
let _1 =
-# 3393 "parsing/parser.mly"
+# 3409 "parsing/parser.mly"
( _1 )
-# 19210 "parsing/parser.ml"
+# 19218 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 19218 "parsing/parser.ml"
+# 19226 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3371 "parsing/parser.mly"
+# 3387 "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 )
-# 19229 "parsing/parser.ml"
+# 19237 "parsing/parser.ml"
in
-# 3365 "parsing/parser.mly"
+# 3381 "parsing/parser.mly"
( [head], Closed )
-# 19235 "parsing/parser.ml"
+# 19243 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos_ty_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3389 "parsing/parser.mly"
+# 3405 "parsing/parser.mly"
( Of.inherit_ ~loc:(make_loc _sloc) ty )
-# 19264 "parsing/parser.ml"
+# 19272 "parsing/parser.ml"
in
-# 3365 "parsing/parser.mly"
+# 3381 "parsing/parser.mly"
( [head], Closed )
-# 19270 "parsing/parser.ml"
+# 19278 "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) =
-# 3367 "parsing/parser.mly"
+# 3383 "parsing/parser.mly"
( [], Open )
-# 19295 "parsing/parser.ml"
+# 19303 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in
let _5 : unit = Obj.magic _5 in
let _1_inlined1 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 19342 "parsing/parser.ml"
+# 19350 "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
-# 3164 "parsing/parser.mly"
+# 3180 "parsing/parser.mly"
( _1 )
-# 19356 "parsing/parser.ml"
+# 19364 "parsing/parser.ml"
in
let label =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3393 "parsing/parser.mly"
+# 3409 "parsing/parser.mly"
( _1 )
-# 19364 "parsing/parser.ml"
+# 19372 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 19372 "parsing/parser.ml"
+# 19380 "parsing/parser.ml"
in
let attrs =
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 19378 "parsing/parser.ml"
+# 19386 "parsing/parser.ml"
in
let _1 =
-# 3630 "parsing/parser.mly"
+# 3646 "parsing/parser.mly"
( Fresh )
-# 19383 "parsing/parser.ml"
+# 19391 "parsing/parser.ml"
in
-# 1869 "parsing/parser.mly"
+# 1875 "parsing/parser.mly"
( (label, private_, Cfk_virtual ty), attrs )
-# 19388 "parsing/parser.ml"
+# 19396 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let _5 : (Parsetree.expression) = Obj.magic _5 in
let _1_inlined1 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 19428 "parsing/parser.ml"
+# 19436 "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 =
-# 3393 "parsing/parser.mly"
+# 3409 "parsing/parser.mly"
( _1 )
-# 19442 "parsing/parser.ml"
+# 19450 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 19450 "parsing/parser.ml"
+# 19458 "parsing/parser.ml"
in
let _2 =
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 19456 "parsing/parser.ml"
+# 19464 "parsing/parser.ml"
in
let _1 =
-# 3633 "parsing/parser.mly"
+# 3649 "parsing/parser.mly"
( Fresh )
-# 19461 "parsing/parser.ml"
+# 19469 "parsing/parser.ml"
in
-# 1871 "parsing/parser.mly"
+# 1877 "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 )
-# 19469 "parsing/parser.ml"
+# 19477 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let _5 : (Parsetree.expression) = Obj.magic _5 in
let _1_inlined2 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 19515 "parsing/parser.ml"
+# 19523 "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 =
-# 3393 "parsing/parser.mly"
+# 3409 "parsing/parser.mly"
( _1 )
-# 19530 "parsing/parser.ml"
+# 19538 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 19538 "parsing/parser.ml"
+# 19546 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 19546 "parsing/parser.ml"
+# 19554 "parsing/parser.ml"
in
let _1 =
-# 3634 "parsing/parser.mly"
+# 3650 "parsing/parser.mly"
( Override )
-# 19552 "parsing/parser.ml"
+# 19560 "parsing/parser.ml"
in
-# 1871 "parsing/parser.mly"
+# 1877 "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 )
-# 19560 "parsing/parser.ml"
+# 19568 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in
let _5 : unit = Obj.magic _5 in
let _1_inlined1 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 19621 "parsing/parser.ml"
+# 19629 "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
-# 3164 "parsing/parser.mly"
+# 3180 "parsing/parser.mly"
( _1 )
-# 19635 "parsing/parser.ml"
+# 19643 "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 =
-# 3393 "parsing/parser.mly"
+# 3409 "parsing/parser.mly"
( _1 )
-# 19644 "parsing/parser.ml"
+# 19652 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 19652 "parsing/parser.ml"
+# 19660 "parsing/parser.ml"
in
let _2 =
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 19658 "parsing/parser.ml"
+# 19666 "parsing/parser.ml"
in
let _1 =
-# 3633 "parsing/parser.mly"
+# 3649 "parsing/parser.mly"
( Fresh )
-# 19663 "parsing/parser.ml"
+# 19671 "parsing/parser.ml"
in
-# 1877 "parsing/parser.mly"
+# 1883 "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 )
-# 19671 "parsing/parser.ml"
+# 19679 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined3 : (Parsetree.core_type) = Obj.magic _1_inlined3 in
let _5 : unit = Obj.magic _5 in
let _1_inlined2 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 19738 "parsing/parser.ml"
+# 19746 "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
-# 3164 "parsing/parser.mly"
+# 3180 "parsing/parser.mly"
( _1 )
-# 19753 "parsing/parser.ml"
+# 19761 "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 =
-# 3393 "parsing/parser.mly"
+# 3409 "parsing/parser.mly"
( _1 )
-# 19762 "parsing/parser.ml"
+# 19770 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 19770 "parsing/parser.ml"
+# 19778 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 19778 "parsing/parser.ml"
+# 19786 "parsing/parser.ml"
in
let _1 =
-# 3634 "parsing/parser.mly"
+# 3650 "parsing/parser.mly"
( Override )
-# 19784 "parsing/parser.ml"
+# 19792 "parsing/parser.ml"
in
-# 1877 "parsing/parser.mly"
+# 1883 "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 )
-# 19792 "parsing/parser.ml"
+# 19800 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _6 : unit = Obj.magic _6 in
let _5 : unit = Obj.magic _5 in
let _1_inlined1 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 19874 "parsing/parser.ml"
+# 19882 "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 =
-# 2414 "parsing/parser.mly"
+# 2416 "parsing/parser.mly"
( xs )
-# 19886 "parsing/parser.ml"
+# 19894 "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 =
-# 3393 "parsing/parser.mly"
+# 3409 "parsing/parser.mly"
( _1 )
-# 19894 "parsing/parser.ml"
+# 19902 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 19902 "parsing/parser.ml"
+# 19910 "parsing/parser.ml"
in
let _startpos__4_ = _startpos__1_inlined1_ in
let _2 =
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 19909 "parsing/parser.ml"
+# 19917 "parsing/parser.ml"
in
let (_endpos__2_, _startpos__2_) = (_endpos__1_, _startpos__1_) in
let _1 =
-# 3633 "parsing/parser.mly"
+# 3649 "parsing/parser.mly"
( Fresh )
-# 19915 "parsing/parser.ml"
+# 19923 "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
-# 1883 "parsing/parser.mly"
+# 1889 "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 )
-# 19942 "parsing/parser.ml"
+# 19950 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _6 : unit = Obj.magic _6 in
let _5 : unit = Obj.magic _5 in
let _1_inlined2 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 20030 "parsing/parser.ml"
+# 20038 "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 =
-# 2414 "parsing/parser.mly"
+# 2416 "parsing/parser.mly"
( xs )
-# 20043 "parsing/parser.ml"
+# 20051 "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 =
-# 3393 "parsing/parser.mly"
+# 3409 "parsing/parser.mly"
( _1 )
-# 20051 "parsing/parser.ml"
+# 20059 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 20059 "parsing/parser.ml"
+# 20067 "parsing/parser.ml"
in
let _startpos__4_ = _startpos__1_inlined2_ in
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 20068 "parsing/parser.ml"
+# 20076 "parsing/parser.ml"
in
let (_endpos__2_, _startpos__2_) = (_endpos__1_inlined1_, _startpos__1_inlined1_) in
let _1 =
-# 3634 "parsing/parser.mly"
+# 3650 "parsing/parser.mly"
( Override )
-# 20075 "parsing/parser.ml"
+# 20083 "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
-# 1883 "parsing/parser.mly"
+# 1889 "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 )
-# 20101 "parsing/parser.ml"
+# 20109 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 20122 "parsing/parser.ml"
+# 20130 "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) =
-# 3490 "parsing/parser.mly"
+# 3506 "parsing/parser.mly"
( Lident _1 )
-# 20130 "parsing/parser.ml"
+# 20138 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _3 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 20163 "parsing/parser.ml"
+# 20171 "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) =
-# 3491 "parsing/parser.mly"
+# 3507 "parsing/parser.mly"
( Ldot(_1,_3) )
-# 20173 "parsing/parser.ml"
+# 20181 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 697 "parsing/parser.mly"
+# 701 "parsing/parser.mly"
(string)
-# 20194 "parsing/parser.ml"
+# 20202 "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) =
-# 3490 "parsing/parser.mly"
+# 3506 "parsing/parser.mly"
( Lident _1 )
-# 20202 "parsing/parser.ml"
+# 20210 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _3 : (
-# 697 "parsing/parser.mly"
+# 701 "parsing/parser.mly"
(string)
-# 20235 "parsing/parser.ml"
+# 20243 "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) =
-# 3491 "parsing/parser.mly"
+# 3507 "parsing/parser.mly"
( Ldot(_1,_3) )
-# 20245 "parsing/parser.ml"
+# 20253 "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 =
-# 3527 "parsing/parser.mly"
+# 3543 "parsing/parser.mly"
( _1 )
-# 20270 "parsing/parser.ml"
+# 20278 "parsing/parser.ml"
in
-# 3490 "parsing/parser.mly"
+# 3506 "parsing/parser.mly"
( Lident _1 )
-# 20275 "parsing/parser.ml"
+# 20283 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Longident.t) = let _1 =
let _1 =
-# 3470 "parsing/parser.mly"
+# 3486 "parsing/parser.mly"
( "::" )
-# 20315 "parsing/parser.ml"
+# 20323 "parsing/parser.ml"
in
-# 3527 "parsing/parser.mly"
+# 3543 "parsing/parser.mly"
( _1 )
-# 20320 "parsing/parser.ml"
+# 20328 "parsing/parser.ml"
in
-# 3490 "parsing/parser.mly"
+# 3506 "parsing/parser.mly"
( Lident _1 )
-# 20326 "parsing/parser.ml"
+# 20334 "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 =
-# 3527 "parsing/parser.mly"
+# 3543 "parsing/parser.mly"
( _1 )
-# 20351 "parsing/parser.ml"
+# 20359 "parsing/parser.ml"
in
-# 3490 "parsing/parser.mly"
+# 3506 "parsing/parser.mly"
( Lident _1 )
-# 20356 "parsing/parser.ml"
+# 20364 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Longident.t) = let _3 =
let _1 = _1_inlined1 in
-# 3527 "parsing/parser.mly"
+# 3543 "parsing/parser.mly"
( _1 )
-# 20397 "parsing/parser.ml"
+# 20405 "parsing/parser.ml"
in
-# 3491 "parsing/parser.mly"
+# 3507 "parsing/parser.mly"
( Ldot(_1,_3) )
-# 20403 "parsing/parser.ml"
+# 20411 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Longident.t) = let _3 =
let (_2, _1) = (_2_inlined1, _1_inlined1) in
let _1 =
-# 3470 "parsing/parser.mly"
+# 3486 "parsing/parser.mly"
( "::" )
-# 20458 "parsing/parser.ml"
+# 20466 "parsing/parser.ml"
in
-# 3527 "parsing/parser.mly"
+# 3543 "parsing/parser.mly"
( _1 )
-# 20463 "parsing/parser.ml"
+# 20471 "parsing/parser.ml"
in
-# 3491 "parsing/parser.mly"
+# 3507 "parsing/parser.mly"
( Ldot(_1,_3) )
-# 20469 "parsing/parser.ml"
+# 20477 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Longident.t) = let _3 =
let _1 = _1_inlined1 in
-# 3527 "parsing/parser.mly"
+# 3543 "parsing/parser.mly"
( _1 )
-# 20510 "parsing/parser.ml"
+# 20518 "parsing/parser.ml"
in
-# 3491 "parsing/parser.mly"
+# 3507 "parsing/parser.mly"
( Ldot(_1,_3) )
-# 20516 "parsing/parser.ml"
+# 20524 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3490 "parsing/parser.mly"
+# 3506 "parsing/parser.mly"
( Lident _1 )
-# 20541 "parsing/parser.ml"
+# 20549 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Longident.t) =
-# 3491 "parsing/parser.mly"
+# 3507 "parsing/parser.mly"
( Ldot(_1,_3) )
-# 20580 "parsing/parser.ml"
+# 20588 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 20601 "parsing/parser.ml"
+# 20609 "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) =
-# 3490 "parsing/parser.mly"
+# 3506 "parsing/parser.mly"
( Lident _1 )
-# 20609 "parsing/parser.ml"
+# 20617 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _3 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 20642 "parsing/parser.ml"
+# 20650 "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) =
-# 3491 "parsing/parser.mly"
+# 3507 "parsing/parser.mly"
( Ldot(_1,_3) )
-# 20652 "parsing/parser.ml"
+# 20660 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 697 "parsing/parser.mly"
+# 701 "parsing/parser.mly"
(string)
-# 20673 "parsing/parser.ml"
+# 20681 "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) =
-# 3490 "parsing/parser.mly"
+# 3506 "parsing/parser.mly"
( Lident _1 )
-# 20681 "parsing/parser.ml"
+# 20689 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _3 : (
-# 697 "parsing/parser.mly"
+# 701 "parsing/parser.mly"
(string)
-# 20714 "parsing/parser.ml"
+# 20722 "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) =
-# 3491 "parsing/parser.mly"
+# 3507 "parsing/parser.mly"
( Ldot(_1,_3) )
-# 20724 "parsing/parser.ml"
+# 20732 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3490 "parsing/parser.mly"
+# 3506 "parsing/parser.mly"
( Lident _1 )
-# 20749 "parsing/parser.ml"
+# 20757 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Longident.t) =
-# 3491 "parsing/parser.mly"
+# 3507 "parsing/parser.mly"
( Ldot(_1,_3) )
-# 20788 "parsing/parser.ml"
+# 20796 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3506 "parsing/parser.mly"
+# 3522 "parsing/parser.mly"
( _1 )
-# 20813 "parsing/parser.ml"
+# 20821 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3508 "parsing/parser.mly"
+# 3524 "parsing/parser.mly"
( lapply ~loc:_sloc _1 _3 )
-# 20862 "parsing/parser.ml"
+# 20870 "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
-# 3510 "parsing/parser.mly"
+# 3526 "parsing/parser.mly"
( expecting _loc__3_ "module path" )
-# 20902 "parsing/parser.ml"
+# 20910 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3503 "parsing/parser.mly"
+# 3519 "parsing/parser.mly"
( _1 )
-# 20927 "parsing/parser.ml"
+# 20935 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos_me_ in
let _v : (Parsetree.module_expr) =
-# 1373 "parsing/parser.mly"
+# 1377 "parsing/parser.mly"
( me )
-# 20959 "parsing/parser.ml"
+# 20967 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_me_ in
let _v : (Parsetree.module_expr) = let _1 =
let _1 =
-# 1376 "parsing/parser.mly"
+# 1380 "parsing/parser.mly"
( Pmod_constraint(me, mty) )
-# 21006 "parsing/parser.ml"
+# 21014 "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
-# 856 "parsing/parser.mly"
+# 860 "parsing/parser.mly"
( mkmod ~loc:_sloc _1 )
-# 21015 "parsing/parser.ml"
+# 21023 "parsing/parser.ml"
in
-# 1379 "parsing/parser.mly"
+# 1384 "parsing/parser.mly"
( _1 )
-# 21021 "parsing/parser.ml"
+# 21029 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos_body_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = arg;
- MenhirLib.EngineTypes.startp = _startpos_arg_;
- MenhirLib.EngineTypes.endp = _endpos_arg_;
+ MenhirLib.EngineTypes.semv = arg_and_pos;
+ MenhirLib.EngineTypes.startp = _startpos_arg_and_pos_;
+ MenhirLib.EngineTypes.endp = _endpos_arg_and_pos_;
MenhirLib.EngineTypes.next = _menhir_stack;
};
} = _menhir_stack in
let body : (Parsetree.module_expr) = Obj.magic body in
- let arg : (Parsetree.functor_parameter) = Obj.magic arg in
+ let arg_and_pos : (Lexing.position * Parsetree.functor_parameter) = Obj.magic arg_and_pos in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
- let _startpos = _startpos_arg_ in
+ let _startpos = _startpos_arg_and_pos_ in
let _endpos = _endpos_body_ in
let _v : (Parsetree.module_expr) = let _1 =
let _1 =
-# 1378 "parsing/parser.mly"
- ( Pmod_functor(arg, body) )
-# 21054 "parsing/parser.ml"
+# 1382 "parsing/parser.mly"
+ ( let (_, arg) = arg_and_pos in
+ Pmod_functor(arg, body) )
+# 21063 "parsing/parser.ml"
in
- let (_endpos__1_, _startpos__1_) = (_endpos_body_, _startpos_arg_) 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
-# 856 "parsing/parser.mly"
+# 860 "parsing/parser.mly"
( mkmod ~loc:_sloc _1 )
-# 21063 "parsing/parser.ml"
+# 21072 "parsing/parser.ml"
in
-# 1379 "parsing/parser.mly"
+# 1384 "parsing/parser.mly"
( _1 )
-# 21069 "parsing/parser.ml"
+# 21078 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos_mty_ in
let _v : (Parsetree.module_type) =
-# 1616 "parsing/parser.mly"
+# 1621 "parsing/parser.mly"
( mty )
-# 21101 "parsing/parser.ml"
+# 21110 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos_body_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = arg;
- MenhirLib.EngineTypes.startp = _startpos_arg_;
- MenhirLib.EngineTypes.endp = _endpos_arg_;
+ MenhirLib.EngineTypes.semv = arg_and_pos;
+ MenhirLib.EngineTypes.startp = _startpos_arg_and_pos_;
+ MenhirLib.EngineTypes.endp = _endpos_arg_and_pos_;
MenhirLib.EngineTypes.next = _menhir_stack;
};
} = _menhir_stack in
let body : (Parsetree.module_type) = Obj.magic body in
- let arg : (Parsetree.functor_parameter) = Obj.magic arg in
+ let arg_and_pos : (Lexing.position * Parsetree.functor_parameter) = Obj.magic arg_and_pos in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
- let _startpos = _startpos_arg_ in
+ let _startpos = _startpos_arg_and_pos_ in
let _endpos = _endpos_body_ in
let _v : (Parsetree.module_type) = let _1 =
let _1 =
-# 1619 "parsing/parser.mly"
- ( Pmty_functor(arg, body) )
-# 21134 "parsing/parser.ml"
+# 1624 "parsing/parser.mly"
+ ( let (_, arg) = arg_and_pos in
+ Pmty_functor(arg, body) )
+# 21144 "parsing/parser.ml"
in
- let (_endpos__1_, _startpos__1_) = (_endpos_body_, _startpos_arg_) 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
-# 858 "parsing/parser.mly"
+# 862 "parsing/parser.mly"
( mkmty ~loc:_sloc _1 )
-# 21143 "parsing/parser.ml"
+# 21153 "parsing/parser.ml"
in
-# 1621 "parsing/parser.mly"
+# 1627 "parsing/parser.mly"
( _1 )
-# 21149 "parsing/parser.ml"
+# 21159 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_expr) = let attrs =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 21197 "parsing/parser.ml"
+# 21207 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1212 "parsing/parser.mly"
+# 1216 "parsing/parser.mly"
( mkmod ~loc:_sloc ~attrs (Pmod_structure s) )
-# 21206 "parsing/parser.ml"
+# 21216 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_expr) = let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 21254 "parsing/parser.ml"
+# 21264 "parsing/parser.ml"
in
let _loc__4_ = (_startpos__4_, _endpos__4_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1214 "parsing/parser.mly"
+# 1218 "parsing/parser.mly"
( unclosed "struct" _loc__1_ "end" _loc__4_ )
-# 21262 "parsing/parser.ml"
+# 21272 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let me : (Parsetree.module_expr) = Obj.magic me in
let _4 : unit = Obj.magic _4 in
- let _1_inlined2 : (Parsetree.functor_parameter list) = Obj.magic _1_inlined2 in
+ let _1_inlined2 : ((Lexing.position * Parsetree.functor_parameter) list) = Obj.magic _1_inlined2 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _v : (Parsetree.module_expr) = let args =
let _1 = _1_inlined2 in
-# 1178 "parsing/parser.mly"
+# 1182 "parsing/parser.mly"
( _1 )
-# 21317 "parsing/parser.ml"
+# 21327 "parsing/parser.ml"
in
let attrs =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 21325 "parsing/parser.ml"
+# 21335 "parsing/parser.ml"
in
let _endpos = _endpos_me_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1216 "parsing/parser.mly"
+# 1220 "parsing/parser.mly"
( wrap_mod_attrs ~loc:_sloc attrs (
- List.fold_left (fun acc arg ->
- mkmod ~loc:_sloc (Pmod_functor (arg, acc))
+ List.fold_left (fun acc (startpos, arg) ->
+ mkmod ~loc:(startpos, _endpos) (Pmod_functor (arg, acc))
) me args
) )
-# 21338 "parsing/parser.ml"
+# 21348 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_me_ in
let _endpos = _endpos_me_ in
let _v : (Parsetree.module_expr) =
-# 1222 "parsing/parser.mly"
+# 1226 "parsing/parser.mly"
( me )
-# 21363 "parsing/parser.ml"
+# 21373 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_me_ in
let _endpos = _endpos_attr_ in
let _v : (Parsetree.module_expr) =
-# 1224 "parsing/parser.mly"
+# 1228 "parsing/parser.mly"
( Mod.attr me attr )
-# 21395 "parsing/parser.ml"
+# 21405 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 21426 "parsing/parser.ml"
+# 21436 "parsing/parser.ml"
in
-# 1228 "parsing/parser.mly"
+# 1232 "parsing/parser.mly"
( Pmod_ident x )
-# 21432 "parsing/parser.ml"
+# 21442 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 856 "parsing/parser.mly"
+# 860 "parsing/parser.mly"
( mkmod ~loc:_sloc _1 )
-# 21441 "parsing/parser.ml"
+# 21451 "parsing/parser.ml"
in
-# 1240 "parsing/parser.mly"
+# 1244 "parsing/parser.mly"
( _1 )
-# 21447 "parsing/parser.ml"
+# 21457 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_me2_ in
let _v : (Parsetree.module_expr) = let _1 =
let _1 =
-# 1231 "parsing/parser.mly"
+# 1235 "parsing/parser.mly"
( Pmod_apply(me1, me2) )
-# 21480 "parsing/parser.ml"
+# 21490 "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
-# 856 "parsing/parser.mly"
+# 860 "parsing/parser.mly"
( mkmod ~loc:_sloc _1 )
-# 21489 "parsing/parser.ml"
+# 21499 "parsing/parser.ml"
in
-# 1240 "parsing/parser.mly"
+# 1244 "parsing/parser.mly"
( _1 )
-# 21495 "parsing/parser.ml"
+# 21505 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos_me1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1234 "parsing/parser.mly"
+# 1238 "parsing/parser.mly"
( (* TODO review mkmod location *)
Pmod_apply(me1, mkmod ~loc:_sloc (Pmod_structure [])) )
-# 21540 "parsing/parser.ml"
+# 21550 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__3_, _startpos_me1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 856 "parsing/parser.mly"
+# 860 "parsing/parser.mly"
( mkmod ~loc:_sloc _1 )
-# 21550 "parsing/parser.ml"
+# 21560 "parsing/parser.ml"
in
-# 1240 "parsing/parser.mly"
+# 1244 "parsing/parser.mly"
( _1 )
-# 21556 "parsing/parser.ml"
+# 21566 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_ex_ in
let _v : (Parsetree.module_expr) = let _1 =
let _1 =
-# 1238 "parsing/parser.mly"
+# 1242 "parsing/parser.mly"
( Pmod_extension ex )
-# 21582 "parsing/parser.ml"
+# 21592 "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
-# 856 "parsing/parser.mly"
+# 860 "parsing/parser.mly"
( mkmod ~loc:_sloc _1 )
-# 21591 "parsing/parser.ml"
+# 21601 "parsing/parser.ml"
in
-# 1240 "parsing/parser.mly"
+# 1244 "parsing/parser.mly"
( _1 )
-# 21597 "parsing/parser.ml"
+# 21607 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let x : (
-# 697 "parsing/parser.mly"
+# 701 "parsing/parser.mly"
(string)
-# 21618 "parsing/parser.ml"
+# 21628 "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) =
-# 1195 "parsing/parser.mly"
+# 1199 "parsing/parser.mly"
( Some x )
-# 21626 "parsing/parser.ml"
+# 21636 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string option) =
-# 1198 "parsing/parser.mly"
+# 1202 "parsing/parser.mly"
( None )
-# 21651 "parsing/parser.ml"
+# 21661 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined3 : (Longident.t) = Obj.magic _1_inlined3 in
let _5 : unit = Obj.magic _5 in
let _1_inlined2 : (
-# 697 "parsing/parser.mly"
+# 701 "parsing/parser.mly"
(string)
-# 21711 "parsing/parser.ml"
+# 21721 "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
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 21724 "parsing/parser.ml"
+# 21734 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 21736 "parsing/parser.ml"
+# 21746 "parsing/parser.ml"
in
let uid =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 21747 "parsing/parser.ml"
+# 21757 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 21755 "parsing/parser.ml"
+# 21765 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1651 "parsing/parser.mly"
+# 1657 "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
)
-# 21769 "parsing/parser.ml"
+# 21779 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _6 : unit = Obj.magic _6 in
let _5 : unit = Obj.magic _5 in
let _1_inlined2 : (
-# 697 "parsing/parser.mly"
+# 701 "parsing/parser.mly"
(string)
-# 21822 "parsing/parser.ml"
+# 21832 "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
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 21838 "parsing/parser.ml"
+# 21848 "parsing/parser.ml"
in
let _3 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 21846 "parsing/parser.ml"
+# 21856 "parsing/parser.ml"
in
let _loc__6_ = (_startpos__6_, _endpos__6_) in
-# 1658 "parsing/parser.mly"
+# 1664 "parsing/parser.mly"
( expecting _loc__6_ "module path" )
-# 21853 "parsing/parser.ml"
+# 21863 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_type) = let attrs =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 21901 "parsing/parser.ml"
+# 21911 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1504 "parsing/parser.mly"
+# 1509 "parsing/parser.mly"
( mkmty ~loc:_sloc ~attrs (Pmty_signature s) )
-# 21910 "parsing/parser.ml"
+# 21920 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_type) = let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 21958 "parsing/parser.ml"
+# 21968 "parsing/parser.ml"
in
let _loc__4_ = (_startpos__4_, _endpos__4_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1506 "parsing/parser.mly"
+# 1511 "parsing/parser.mly"
( unclosed "sig" _loc__1_ "end" _loc__4_ )
-# 21966 "parsing/parser.ml"
+# 21976 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let mty : (Parsetree.module_type) = Obj.magic mty in
let _4 : unit = Obj.magic _4 in
- let _1_inlined2 : (Parsetree.functor_parameter list) = Obj.magic _1_inlined2 in
+ let _1_inlined2 : ((Lexing.position * Parsetree.functor_parameter) list) = Obj.magic _1_inlined2 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _v : (Parsetree.module_type) = let args =
let _1 = _1_inlined2 in
-# 1178 "parsing/parser.mly"
+# 1182 "parsing/parser.mly"
( _1 )
-# 22021 "parsing/parser.ml"
+# 22031 "parsing/parser.ml"
in
let attrs =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 22029 "parsing/parser.ml"
+# 22039 "parsing/parser.ml"
in
let _endpos = _endpos_mty_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1510 "parsing/parser.mly"
+# 1515 "parsing/parser.mly"
( wrap_mty_attrs ~loc:_sloc attrs (
- List.fold_left (fun acc arg ->
- mkmty ~loc:_sloc (Pmty_functor (arg, acc))
+ List.fold_left (fun acc (startpos, arg) ->
+ mkmty ~loc:(startpos, _endpos) (Pmty_functor (arg, acc))
) mty args
) )
-# 22042 "parsing/parser.ml"
+# 22052 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_type) = let _4 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 22097 "parsing/parser.ml"
+# 22107 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1516 "parsing/parser.mly"
+# 1521 "parsing/parser.mly"
( mkmty ~loc:_sloc ~attrs:_4 (Pmty_typeof _5) )
-# 22106 "parsing/parser.ml"
+# 22116 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.module_type) =
-# 1518 "parsing/parser.mly"
+# 1523 "parsing/parser.mly"
( _2 )
-# 22145 "parsing/parser.ml"
+# 22155 "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
-# 1520 "parsing/parser.mly"
+# 1525 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__3_ )
-# 22186 "parsing/parser.ml"
+# 22196 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.module_type) =
-# 1522 "parsing/parser.mly"
+# 1527 "parsing/parser.mly"
( Mty.attr _1 _2 )
-# 22218 "parsing/parser.ml"
+# 22228 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 22249 "parsing/parser.ml"
+# 22259 "parsing/parser.ml"
in
-# 1525 "parsing/parser.mly"
+# 1530 "parsing/parser.mly"
( Pmty_ident _1 )
-# 22255 "parsing/parser.ml"
+# 22265 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 858 "parsing/parser.mly"
+# 862 "parsing/parser.mly"
( mkmty ~loc:_sloc _1 )
-# 22264 "parsing/parser.ml"
+# 22274 "parsing/parser.ml"
in
-# 1536 "parsing/parser.mly"
+# 1541 "parsing/parser.mly"
( _1 )
-# 22270 "parsing/parser.ml"
+# 22280 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.module_type) = let _1 =
let _1 =
-# 1528 "parsing/parser.mly"
+# 1533 "parsing/parser.mly"
( Pmty_functor(Named (mknoloc None, _1), _3) )
-# 22310 "parsing/parser.ml"
+# 22320 "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
-# 858 "parsing/parser.mly"
+# 862 "parsing/parser.mly"
( mkmty ~loc:_sloc _1 )
-# 22319 "parsing/parser.ml"
+# 22329 "parsing/parser.ml"
in
-# 1536 "parsing/parser.mly"
+# 1541 "parsing/parser.mly"
( _1 )
-# 22325 "parsing/parser.ml"
+# 22335 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 22367 "parsing/parser.ml"
+# 22377 "parsing/parser.ml"
in
-# 947 "parsing/parser.mly"
+# 951 "parsing/parser.mly"
( xs )
-# 22372 "parsing/parser.ml"
+# 22382 "parsing/parser.ml"
in
-# 1530 "parsing/parser.mly"
+# 1535 "parsing/parser.mly"
( Pmty_with(_1, _3) )
-# 22378 "parsing/parser.ml"
+# 22388 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_xs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 858 "parsing/parser.mly"
+# 862 "parsing/parser.mly"
( mkmty ~loc:_sloc _1 )
-# 22388 "parsing/parser.ml"
+# 22398 "parsing/parser.ml"
in
-# 1536 "parsing/parser.mly"
+# 1541 "parsing/parser.mly"
( _1 )
-# 22394 "parsing/parser.ml"
+# 22404 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.module_type) = let _1 =
let _1 =
-# 1534 "parsing/parser.mly"
+# 1539 "parsing/parser.mly"
( Pmty_extension _1 )
-# 22420 "parsing/parser.ml"
+# 22430 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 858 "parsing/parser.mly"
+# 862 "parsing/parser.mly"
( mkmty ~loc:_sloc _1 )
-# 22428 "parsing/parser.ml"
+# 22438 "parsing/parser.ml"
in
-# 1536 "parsing/parser.mly"
+# 1541 "parsing/parser.mly"
( _1 )
-# 22434 "parsing/parser.ml"
+# 22444 "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
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 22503 "parsing/parser.ml"
+# 22513 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 22515 "parsing/parser.ml"
+# 22525 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 22523 "parsing/parser.ml"
+# 22533 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1450 "parsing/parser.mly"
+# 1455 "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
)
-# 22537 "parsing/parser.ml"
+# 22547 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3513 "parsing/parser.mly"
+# 3529 "parsing/parser.mly"
( _1 )
-# 22562 "parsing/parser.ml"
+# 22572 "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) =
-# 3590 "parsing/parser.mly"
+# 3606 "parsing/parser.mly"
( Immutable )
-# 22580 "parsing/parser.ml"
+# 22590 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.mutable_flag) =
-# 3591 "parsing/parser.mly"
+# 3607 "parsing/parser.mly"
( Mutable )
-# 22605 "parsing/parser.ml"
+# 22615 "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) =
-# 3599 "parsing/parser.mly"
+# 3615 "parsing/parser.mly"
( Immutable, Concrete )
-# 22623 "parsing/parser.ml"
+# 22633 "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) =
-# 3601 "parsing/parser.mly"
+# 3617 "parsing/parser.mly"
( Mutable, Concrete )
-# 22648 "parsing/parser.ml"
+# 22658 "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) =
-# 3603 "parsing/parser.mly"
+# 3619 "parsing/parser.mly"
( Immutable, Virtual )
-# 22673 "parsing/parser.ml"
+# 22683 "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) =
-# 3606 "parsing/parser.mly"
+# 3622 "parsing/parser.mly"
( Mutable, Virtual )
-# 22705 "parsing/parser.ml"
+# 22715 "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) =
-# 3606 "parsing/parser.mly"
+# 3622 "parsing/parser.mly"
( Mutable, Virtual )
-# 22737 "parsing/parser.ml"
+# 22747 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.label) =
-# 3563 "parsing/parser.mly"
+# 3579 "parsing/parser.mly"
( _2 )
-# 22769 "parsing/parser.ml"
+# 22779 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 22790 "parsing/parser.ml"
+# 22800 "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
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 22802 "parsing/parser.ml"
+# 22812 "parsing/parser.ml"
in
# 221 "<standard.mly>"
( [ x ] )
-# 22808 "parsing/parser.ml"
+# 22818 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let xs : (string Asttypes.loc list) = Obj.magic xs in
let _1 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 22836 "parsing/parser.ml"
+# 22846 "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
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 22848 "parsing/parser.ml"
+# 22858 "parsing/parser.ml"
in
# 223 "<standard.mly>"
( x :: xs )
-# 22854 "parsing/parser.ml"
+# 22864 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let s : (
-# 685 "parsing/parser.mly"
+# 689 "parsing/parser.mly"
(string * Location.t * string option)
-# 22875 "parsing/parser.ml"
+# 22885 "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 =
-# 3559 "parsing/parser.mly"
+# 3575 "parsing/parser.mly"
( let body, _, _ = s in body )
-# 22883 "parsing/parser.ml"
+# 22893 "parsing/parser.ml"
in
# 221 "<standard.mly>"
( [ x ] )
-# 22888 "parsing/parser.ml"
+# 22898 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let xs : (string list) = Obj.magic xs in
let s : (
-# 685 "parsing/parser.mly"
+# 689 "parsing/parser.mly"
(string * Location.t * string option)
-# 22916 "parsing/parser.ml"
+# 22926 "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 =
-# 3559 "parsing/parser.mly"
+# 3575 "parsing/parser.mly"
( let body, _, _ = s in body )
-# 22924 "parsing/parser.ml"
+# 22934 "parsing/parser.ml"
in
# 223 "<standard.mly>"
( x :: xs )
-# 22929 "parsing/parser.ml"
+# 22939 "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 =
-# 3586 "parsing/parser.mly"
+# 3602 "parsing/parser.mly"
( Public )
-# 22954 "parsing/parser.ml"
+# 22964 "parsing/parser.ml"
in
-# 2896 "parsing/parser.mly"
+# 2901 "parsing/parser.mly"
( (Ptype_abstract, priv, Some ty) )
-# 22959 "parsing/parser.ml"
+# 22969 "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 =
-# 3587 "parsing/parser.mly"
+# 3603 "parsing/parser.mly"
( Private )
-# 22991 "parsing/parser.ml"
+# 23001 "parsing/parser.ml"
in
-# 2896 "parsing/parser.mly"
+# 2901 "parsing/parser.mly"
( (Ptype_abstract, priv, Some ty) )
-# 22996 "parsing/parser.ml"
+# 23006 "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 =
-# 3586 "parsing/parser.mly"
+# 3602 "parsing/parser.mly"
( Public )
-# 23021 "parsing/parser.ml"
+# 23031 "parsing/parser.ml"
in
let oty =
let _1 =
# 124 "<standard.mly>"
( None )
-# 23027 "parsing/parser.ml"
+# 23037 "parsing/parser.ml"
in
-# 2912 "parsing/parser.mly"
+# 2917 "parsing/parser.mly"
( _1 )
-# 23032 "parsing/parser.ml"
+# 23042 "parsing/parser.ml"
in
-# 2900 "parsing/parser.mly"
+# 2905 "parsing/parser.mly"
( (Ptype_variant cs, priv, oty) )
-# 23038 "parsing/parser.ml"
+# 23048 "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 =
-# 3587 "parsing/parser.mly"
+# 3603 "parsing/parser.mly"
( Private )
-# 23070 "parsing/parser.ml"
+# 23080 "parsing/parser.ml"
in
let oty =
let _1 =
# 124 "<standard.mly>"
( None )
-# 23076 "parsing/parser.ml"
+# 23086 "parsing/parser.ml"
in
-# 2912 "parsing/parser.mly"
+# 2917 "parsing/parser.mly"
( _1 )
-# 23081 "parsing/parser.ml"
+# 23091 "parsing/parser.ml"
in
-# 2900 "parsing/parser.mly"
+# 2905 "parsing/parser.mly"
( (Ptype_variant cs, priv, oty) )
-# 23087 "parsing/parser.ml"
+# 23097 "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 =
-# 3586 "parsing/parser.mly"
+# 3602 "parsing/parser.mly"
( Public )
-# 23126 "parsing/parser.ml"
+# 23136 "parsing/parser.ml"
in
let oty =
let _1 =
let x =
# 191 "<standard.mly>"
( x )
-# 23133 "parsing/parser.ml"
+# 23143 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 23138 "parsing/parser.ml"
+# 23148 "parsing/parser.ml"
in
-# 2912 "parsing/parser.mly"
+# 2917 "parsing/parser.mly"
( _1 )
-# 23144 "parsing/parser.ml"
+# 23154 "parsing/parser.ml"
in
-# 2900 "parsing/parser.mly"
+# 2905 "parsing/parser.mly"
( (Ptype_variant cs, priv, oty) )
-# 23150 "parsing/parser.ml"
+# 23160 "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 =
-# 3587 "parsing/parser.mly"
+# 3603 "parsing/parser.mly"
( Private )
-# 23196 "parsing/parser.ml"
+# 23206 "parsing/parser.ml"
in
let oty =
let _1 =
let x =
# 191 "<standard.mly>"
( x )
-# 23203 "parsing/parser.ml"
+# 23213 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 23208 "parsing/parser.ml"
+# 23218 "parsing/parser.ml"
in
-# 2912 "parsing/parser.mly"
+# 2917 "parsing/parser.mly"
( _1 )
-# 23214 "parsing/parser.ml"
+# 23224 "parsing/parser.ml"
in
-# 2900 "parsing/parser.mly"
+# 2905 "parsing/parser.mly"
( (Ptype_variant cs, priv, oty) )
-# 23220 "parsing/parser.ml"
+# 23230 "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 =
-# 3586 "parsing/parser.mly"
+# 3602 "parsing/parser.mly"
( Public )
-# 23245 "parsing/parser.ml"
+# 23255 "parsing/parser.ml"
in
let oty =
let _1 =
# 124 "<standard.mly>"
( None )
-# 23251 "parsing/parser.ml"
+# 23261 "parsing/parser.ml"
in
-# 2912 "parsing/parser.mly"
+# 2917 "parsing/parser.mly"
( _1 )
-# 23256 "parsing/parser.ml"
+# 23266 "parsing/parser.ml"
in
-# 2904 "parsing/parser.mly"
+# 2909 "parsing/parser.mly"
( (Ptype_open, priv, oty) )
-# 23262 "parsing/parser.ml"
+# 23272 "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 =
-# 3587 "parsing/parser.mly"
+# 3603 "parsing/parser.mly"
( Private )
-# 23294 "parsing/parser.ml"
+# 23304 "parsing/parser.ml"
in
let oty =
let _1 =
# 124 "<standard.mly>"
( None )
-# 23300 "parsing/parser.ml"
+# 23310 "parsing/parser.ml"
in
-# 2912 "parsing/parser.mly"
+# 2917 "parsing/parser.mly"
( _1 )
-# 23305 "parsing/parser.ml"
+# 23315 "parsing/parser.ml"
in
-# 2904 "parsing/parser.mly"
+# 2909 "parsing/parser.mly"
( (Ptype_open, priv, oty) )
-# 23311 "parsing/parser.ml"
+# 23321 "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 =
-# 3586 "parsing/parser.mly"
+# 3602 "parsing/parser.mly"
( Public )
-# 23350 "parsing/parser.ml"
+# 23360 "parsing/parser.ml"
in
let oty =
let _1 =
let x =
# 191 "<standard.mly>"
( x )
-# 23357 "parsing/parser.ml"
+# 23367 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 23362 "parsing/parser.ml"
+# 23372 "parsing/parser.ml"
in
-# 2912 "parsing/parser.mly"
+# 2917 "parsing/parser.mly"
( _1 )
-# 23368 "parsing/parser.ml"
+# 23378 "parsing/parser.ml"
in
-# 2904 "parsing/parser.mly"
+# 2909 "parsing/parser.mly"
( (Ptype_open, priv, oty) )
-# 23374 "parsing/parser.ml"
+# 23384 "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 =
-# 3587 "parsing/parser.mly"
+# 3603 "parsing/parser.mly"
( Private )
-# 23420 "parsing/parser.ml"
+# 23430 "parsing/parser.ml"
in
let oty =
let _1 =
let x =
# 191 "<standard.mly>"
( x )
-# 23427 "parsing/parser.ml"
+# 23437 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 23432 "parsing/parser.ml"
+# 23442 "parsing/parser.ml"
in
-# 2912 "parsing/parser.mly"
+# 2917 "parsing/parser.mly"
( _1 )
-# 23438 "parsing/parser.ml"
+# 23448 "parsing/parser.ml"
in
-# 2904 "parsing/parser.mly"
+# 2909 "parsing/parser.mly"
( (Ptype_open, priv, oty) )
-# 23444 "parsing/parser.ml"
+# 23454 "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 =
-# 3586 "parsing/parser.mly"
+# 3602 "parsing/parser.mly"
( Public )
-# 23483 "parsing/parser.ml"
+# 23493 "parsing/parser.ml"
in
let oty =
let _1 =
# 124 "<standard.mly>"
( None )
-# 23489 "parsing/parser.ml"
+# 23499 "parsing/parser.ml"
in
-# 2912 "parsing/parser.mly"
+# 2917 "parsing/parser.mly"
( _1 )
-# 23494 "parsing/parser.ml"
+# 23504 "parsing/parser.ml"
in
-# 2908 "parsing/parser.mly"
+# 2913 "parsing/parser.mly"
( (Ptype_record ls, priv, oty) )
-# 23500 "parsing/parser.ml"
+# 23510 "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 =
-# 3587 "parsing/parser.mly"
+# 3603 "parsing/parser.mly"
( Private )
-# 23546 "parsing/parser.ml"
+# 23556 "parsing/parser.ml"
in
let oty =
let _1 =
# 124 "<standard.mly>"
( None )
-# 23552 "parsing/parser.ml"
+# 23562 "parsing/parser.ml"
in
-# 2912 "parsing/parser.mly"
+# 2917 "parsing/parser.mly"
( _1 )
-# 23557 "parsing/parser.ml"
+# 23567 "parsing/parser.ml"
in
-# 2908 "parsing/parser.mly"
+# 2913 "parsing/parser.mly"
( (Ptype_record ls, priv, oty) )
-# 23563 "parsing/parser.ml"
+# 23573 "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 =
-# 3586 "parsing/parser.mly"
+# 3602 "parsing/parser.mly"
( Public )
-# 23616 "parsing/parser.ml"
+# 23626 "parsing/parser.ml"
in
let oty =
let _1 =
let x =
# 191 "<standard.mly>"
( x )
-# 23623 "parsing/parser.ml"
+# 23633 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 23628 "parsing/parser.ml"
+# 23638 "parsing/parser.ml"
in
-# 2912 "parsing/parser.mly"
+# 2917 "parsing/parser.mly"
( _1 )
-# 23634 "parsing/parser.ml"
+# 23644 "parsing/parser.ml"
in
-# 2908 "parsing/parser.mly"
+# 2913 "parsing/parser.mly"
( (Ptype_record ls, priv, oty) )
-# 23640 "parsing/parser.ml"
+# 23650 "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 =
-# 3587 "parsing/parser.mly"
+# 3603 "parsing/parser.mly"
( Private )
-# 23700 "parsing/parser.ml"
+# 23710 "parsing/parser.ml"
in
let oty =
let _1 =
let x =
# 191 "<standard.mly>"
( x )
-# 23707 "parsing/parser.ml"
+# 23717 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 23712 "parsing/parser.ml"
+# 23722 "parsing/parser.ml"
in
-# 2912 "parsing/parser.mly"
+# 2917 "parsing/parser.mly"
( _1 )
-# 23718 "parsing/parser.ml"
+# 23728 "parsing/parser.ml"
in
-# 2908 "parsing/parser.mly"
+# 2913 "parsing/parser.mly"
( (Ptype_record ls, priv, oty) )
-# 23724 "parsing/parser.ml"
+# 23734 "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
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 23779 "parsing/parser.ml"
+# 23789 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined2_ in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 23788 "parsing/parser.ml"
+# 23798 "parsing/parser.ml"
in
let override =
-# 3633 "parsing/parser.mly"
+# 3649 "parsing/parser.mly"
( Fresh )
-# 23794 "parsing/parser.ml"
+# 23804 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1469 "parsing/parser.mly"
+# 1474 "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
)
-# 23807 "parsing/parser.ml"
+# 23817 "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
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 23869 "parsing/parser.ml"
+# 23879 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let attrs1 =
let _1 = _1_inlined2 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 23878 "parsing/parser.ml"
+# 23888 "parsing/parser.ml"
in
let override =
let _1 = _1_inlined1 in
-# 3634 "parsing/parser.mly"
+# 3650 "parsing/parser.mly"
( Override )
-# 23886 "parsing/parser.ml"
+# 23896 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1469 "parsing/parser.mly"
+# 1474 "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
)
-# 23900 "parsing/parser.ml"
+# 23910 "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
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 23955 "parsing/parser.ml"
+# 23965 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 23967 "parsing/parser.ml"
+# 23977 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 23975 "parsing/parser.ml"
+# 23985 "parsing/parser.ml"
in
let override =
-# 3633 "parsing/parser.mly"
+# 3649 "parsing/parser.mly"
( Fresh )
-# 23981 "parsing/parser.ml"
+# 23991 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1484 "parsing/parser.mly"
+# 1489 "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
)
-# 23994 "parsing/parser.ml"
+# 24004 "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
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 24056 "parsing/parser.ml"
+# 24066 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 24068 "parsing/parser.ml"
+# 24078 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined2 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 24076 "parsing/parser.ml"
+# 24086 "parsing/parser.ml"
in
let override =
let _1 = _1_inlined1 in
-# 3634 "parsing/parser.mly"
+# 3650 "parsing/parser.mly"
( Override )
-# 24084 "parsing/parser.ml"
+# 24094 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1484 "parsing/parser.mly"
+# 1489 "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
)
-# 24098 "parsing/parser.ml"
+# 24108 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 671 "parsing/parser.mly"
+# 675 "parsing/parser.mly"
(string)
-# 24119 "parsing/parser.ml"
+# 24129 "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) =
-# 3429 "parsing/parser.mly"
+# 3445 "parsing/parser.mly"
( _1 )
-# 24127 "parsing/parser.ml"
+# 24137 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 629 "parsing/parser.mly"
+# 633 "parsing/parser.mly"
(string)
-# 24148 "parsing/parser.ml"
+# 24158 "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) =
-# 3430 "parsing/parser.mly"
+# 3446 "parsing/parser.mly"
( _1 )
-# 24156 "parsing/parser.ml"
+# 24166 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 630 "parsing/parser.mly"
+# 634 "parsing/parser.mly"
(string)
-# 24177 "parsing/parser.ml"
+# 24187 "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) =
-# 3431 "parsing/parser.mly"
+# 3447 "parsing/parser.mly"
( _1 )
-# 24185 "parsing/parser.ml"
+# 24195 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 : (string) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 628 "parsing/parser.mly"
+# 632 "parsing/parser.mly"
(string)
-# 24227 "parsing/parser.ml"
+# 24237 "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) =
-# 3432 "parsing/parser.mly"
+# 3448 "parsing/parser.mly"
( "."^ _1 ^"(" ^ _3 ^ ")" )
-# 24235 "parsing/parser.ml"
+# 24245 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 : (string) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 628 "parsing/parser.mly"
+# 632 "parsing/parser.mly"
(string)
-# 24284 "parsing/parser.ml"
+# 24294 "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) =
-# 3433 "parsing/parser.mly"
+# 3449 "parsing/parser.mly"
( "."^ _1 ^ "(" ^ _3 ^ ")<-" )
-# 24292 "parsing/parser.ml"
+# 24302 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 : (string) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 628 "parsing/parser.mly"
+# 632 "parsing/parser.mly"
(string)
-# 24334 "parsing/parser.ml"
+# 24344 "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) =
-# 3434 "parsing/parser.mly"
+# 3450 "parsing/parser.mly"
( "."^ _1 ^"[" ^ _3 ^ "]" )
-# 24342 "parsing/parser.ml"
+# 24352 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 : (string) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 628 "parsing/parser.mly"
+# 632 "parsing/parser.mly"
(string)
-# 24391 "parsing/parser.ml"
+# 24401 "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) =
-# 3435 "parsing/parser.mly"
+# 3451 "parsing/parser.mly"
( "."^ _1 ^ "[" ^ _3 ^ "]<-" )
-# 24399 "parsing/parser.ml"
+# 24409 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 : (string) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 628 "parsing/parser.mly"
+# 632 "parsing/parser.mly"
(string)
-# 24441 "parsing/parser.ml"
+# 24451 "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) =
-# 3436 "parsing/parser.mly"
+# 3452 "parsing/parser.mly"
( "."^ _1 ^"{" ^ _3 ^ "}" )
-# 24449 "parsing/parser.ml"
+# 24459 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 : (string) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 628 "parsing/parser.mly"
+# 632 "parsing/parser.mly"
(string)
-# 24498 "parsing/parser.ml"
+# 24508 "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) =
-# 3437 "parsing/parser.mly"
+# 3453 "parsing/parser.mly"
( "."^ _1 ^ "{" ^ _3 ^ "}<-" )
-# 24506 "parsing/parser.ml"
+# 24516 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 682 "parsing/parser.mly"
+# 686 "parsing/parser.mly"
(string)
-# 24527 "parsing/parser.ml"
+# 24537 "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) =
-# 3438 "parsing/parser.mly"
+# 3454 "parsing/parser.mly"
( _1 )
-# 24535 "parsing/parser.ml"
+# 24545 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) =
-# 3439 "parsing/parser.mly"
+# 3455 "parsing/parser.mly"
( "!" )
-# 24560 "parsing/parser.ml"
+# 24570 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let op : (
-# 623 "parsing/parser.mly"
+# 627 "parsing/parser.mly"
(string)
-# 24581 "parsing/parser.ml"
+# 24591 "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 =
-# 3443 "parsing/parser.mly"
+# 3459 "parsing/parser.mly"
( op )
-# 24589 "parsing/parser.ml"
+# 24599 "parsing/parser.ml"
in
-# 3440 "parsing/parser.mly"
+# 3456 "parsing/parser.mly"
( _1 )
-# 24594 "parsing/parser.ml"
+# 24604 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let op : (
-# 624 "parsing/parser.mly"
+# 628 "parsing/parser.mly"
(string)
-# 24615 "parsing/parser.ml"
+# 24625 "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 =
-# 3444 "parsing/parser.mly"
+# 3460 "parsing/parser.mly"
( op )
-# 24623 "parsing/parser.ml"
+# 24633 "parsing/parser.ml"
in
-# 3440 "parsing/parser.mly"
+# 3456 "parsing/parser.mly"
( _1 )
-# 24628 "parsing/parser.ml"
+# 24638 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let op : (
-# 625 "parsing/parser.mly"
+# 629 "parsing/parser.mly"
(string)
-# 24649 "parsing/parser.ml"
+# 24659 "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 =
-# 3445 "parsing/parser.mly"
+# 3461 "parsing/parser.mly"
( op )
-# 24657 "parsing/parser.ml"
+# 24667 "parsing/parser.ml"
in
-# 3440 "parsing/parser.mly"
+# 3456 "parsing/parser.mly"
( _1 )
-# 24662 "parsing/parser.ml"
+# 24672 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let op : (
-# 626 "parsing/parser.mly"
+# 630 "parsing/parser.mly"
(string)
-# 24683 "parsing/parser.ml"
+# 24693 "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 =
-# 3446 "parsing/parser.mly"
+# 3462 "parsing/parser.mly"
( op )
-# 24691 "parsing/parser.ml"
+# 24701 "parsing/parser.ml"
in
-# 3440 "parsing/parser.mly"
+# 3456 "parsing/parser.mly"
( _1 )
-# 24696 "parsing/parser.ml"
+# 24706 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let op : (
-# 627 "parsing/parser.mly"
+# 631 "parsing/parser.mly"
(string)
-# 24717 "parsing/parser.ml"
+# 24727 "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 =
-# 3447 "parsing/parser.mly"
+# 3463 "parsing/parser.mly"
( op )
-# 24725 "parsing/parser.ml"
+# 24735 "parsing/parser.ml"
in
-# 3440 "parsing/parser.mly"
+# 3456 "parsing/parser.mly"
( _1 )
-# 24730 "parsing/parser.ml"
+# 24740 "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 =
-# 3448 "parsing/parser.mly"
+# 3464 "parsing/parser.mly"
("+")
-# 24755 "parsing/parser.ml"
+# 24765 "parsing/parser.ml"
in
-# 3440 "parsing/parser.mly"
+# 3456 "parsing/parser.mly"
( _1 )
-# 24760 "parsing/parser.ml"
+# 24770 "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 =
-# 3449 "parsing/parser.mly"
+# 3465 "parsing/parser.mly"
("+.")
-# 24785 "parsing/parser.ml"
+# 24795 "parsing/parser.ml"
in
-# 3440 "parsing/parser.mly"
+# 3456 "parsing/parser.mly"
( _1 )
-# 24790 "parsing/parser.ml"
+# 24800 "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 =
-# 3450 "parsing/parser.mly"
+# 3466 "parsing/parser.mly"
("+=")
-# 24815 "parsing/parser.ml"
+# 24825 "parsing/parser.ml"
in
-# 3440 "parsing/parser.mly"
+# 3456 "parsing/parser.mly"
( _1 )
-# 24820 "parsing/parser.ml"
+# 24830 "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 =
-# 3451 "parsing/parser.mly"
+# 3467 "parsing/parser.mly"
("-")
-# 24845 "parsing/parser.ml"
+# 24855 "parsing/parser.ml"
in
-# 3440 "parsing/parser.mly"
+# 3456 "parsing/parser.mly"
( _1 )
-# 24850 "parsing/parser.ml"
+# 24860 "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 =
-# 3452 "parsing/parser.mly"
+# 3468 "parsing/parser.mly"
("-.")
-# 24875 "parsing/parser.ml"
+# 24885 "parsing/parser.ml"
in
-# 3440 "parsing/parser.mly"
+# 3456 "parsing/parser.mly"
( _1 )
-# 24880 "parsing/parser.ml"
+# 24890 "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 =
-# 3453 "parsing/parser.mly"
+# 3469 "parsing/parser.mly"
("*")
-# 24905 "parsing/parser.ml"
+# 24915 "parsing/parser.ml"
in
-# 3440 "parsing/parser.mly"
+# 3456 "parsing/parser.mly"
( _1 )
-# 24910 "parsing/parser.ml"
+# 24920 "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 =
-# 3454 "parsing/parser.mly"
+# 3470 "parsing/parser.mly"
("%")
-# 24935 "parsing/parser.ml"
+# 24945 "parsing/parser.ml"
in
-# 3440 "parsing/parser.mly"
+# 3456 "parsing/parser.mly"
( _1 )
-# 24940 "parsing/parser.ml"
+# 24950 "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 =
-# 3455 "parsing/parser.mly"
+# 3471 "parsing/parser.mly"
("=")
-# 24965 "parsing/parser.ml"
+# 24975 "parsing/parser.ml"
in
-# 3440 "parsing/parser.mly"
+# 3456 "parsing/parser.mly"
( _1 )
-# 24970 "parsing/parser.ml"
+# 24980 "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 =
-# 3456 "parsing/parser.mly"
+# 3472 "parsing/parser.mly"
("<")
-# 24995 "parsing/parser.ml"
+# 25005 "parsing/parser.ml"
in
-# 3440 "parsing/parser.mly"
+# 3456 "parsing/parser.mly"
( _1 )
-# 25000 "parsing/parser.ml"
+# 25010 "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 =
-# 3457 "parsing/parser.mly"
+# 3473 "parsing/parser.mly"
(">")
-# 25025 "parsing/parser.ml"
+# 25035 "parsing/parser.ml"
in
-# 3440 "parsing/parser.mly"
+# 3456 "parsing/parser.mly"
( _1 )
-# 25030 "parsing/parser.ml"
+# 25040 "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 =
-# 3458 "parsing/parser.mly"
+# 3474 "parsing/parser.mly"
("or")
-# 25055 "parsing/parser.ml"
+# 25065 "parsing/parser.ml"
in
-# 3440 "parsing/parser.mly"
+# 3456 "parsing/parser.mly"
( _1 )
-# 25060 "parsing/parser.ml"
+# 25070 "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 =
-# 3459 "parsing/parser.mly"
+# 3475 "parsing/parser.mly"
("||")
-# 25085 "parsing/parser.ml"
+# 25095 "parsing/parser.ml"
in
-# 3440 "parsing/parser.mly"
+# 3456 "parsing/parser.mly"
( _1 )
-# 25090 "parsing/parser.ml"
+# 25100 "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 =
-# 3460 "parsing/parser.mly"
+# 3476 "parsing/parser.mly"
("&")
-# 25115 "parsing/parser.ml"
+# 25125 "parsing/parser.ml"
in
-# 3440 "parsing/parser.mly"
+# 3456 "parsing/parser.mly"
( _1 )
-# 25120 "parsing/parser.ml"
+# 25130 "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 =
-# 3461 "parsing/parser.mly"
+# 3477 "parsing/parser.mly"
("&&")
-# 25145 "parsing/parser.ml"
+# 25155 "parsing/parser.ml"
in
-# 3440 "parsing/parser.mly"
+# 3456 "parsing/parser.mly"
( _1 )
-# 25150 "parsing/parser.ml"
+# 25160 "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 =
-# 3462 "parsing/parser.mly"
+# 3478 "parsing/parser.mly"
(":=")
-# 25175 "parsing/parser.ml"
+# 25185 "parsing/parser.ml"
in
-# 3440 "parsing/parser.mly"
+# 3456 "parsing/parser.mly"
( _1 )
-# 25180 "parsing/parser.ml"
+# 25190 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (bool) =
-# 3344 "parsing/parser.mly"
+# 3360 "parsing/parser.mly"
( true )
-# 25205 "parsing/parser.ml"
+# 25215 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (bool) =
-# 3345 "parsing/parser.mly"
+# 3361 "parsing/parser.mly"
( false )
-# 25223 "parsing/parser.ml"
+# 25233 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (unit option) =
# 114 "<standard.mly>"
( None )
-# 25241 "parsing/parser.ml"
+# 25251 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (unit option) =
# 116 "<standard.mly>"
( Some x )
-# 25266 "parsing/parser.ml"
+# 25276 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (unit option) =
# 114 "<standard.mly>"
( None )
-# 25284 "parsing/parser.ml"
+# 25294 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (unit option) =
# 116 "<standard.mly>"
( Some x )
-# 25309 "parsing/parser.ml"
+# 25319 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (string Asttypes.loc option) =
# 114 "<standard.mly>"
( None )
-# 25327 "parsing/parser.ml"
+# 25337 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _1_inlined1 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 25354 "parsing/parser.ml"
+# 25364 "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
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 25369 "parsing/parser.ml"
+# 25379 "parsing/parser.ml"
in
# 183 "<standard.mly>"
( x )
-# 25375 "parsing/parser.ml"
+# 25385 "parsing/parser.ml"
in
# 116 "<standard.mly>"
( Some x )
-# 25381 "parsing/parser.ml"
+# 25391 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.core_type option) =
# 114 "<standard.mly>"
( None )
-# 25399 "parsing/parser.ml"
+# 25409 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.core_type option) = let x =
# 183 "<standard.mly>"
( x )
-# 25431 "parsing/parser.ml"
+# 25441 "parsing/parser.ml"
in
# 116 "<standard.mly>"
( Some x )
-# 25436 "parsing/parser.ml"
+# 25446 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression option) =
# 114 "<standard.mly>"
( None )
-# 25454 "parsing/parser.ml"
+# 25464 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression option) = let x =
# 183 "<standard.mly>"
( x )
-# 25486 "parsing/parser.ml"
+# 25496 "parsing/parser.ml"
in
# 116 "<standard.mly>"
( Some x )
-# 25491 "parsing/parser.ml"
+# 25501 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_type option) =
# 114 "<standard.mly>"
( None )
-# 25509 "parsing/parser.ml"
+# 25519 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_type option) = let x =
# 183 "<standard.mly>"
( x )
-# 25541 "parsing/parser.ml"
+# 25551 "parsing/parser.ml"
in
# 116 "<standard.mly>"
( Some x )
-# 25546 "parsing/parser.ml"
+# 25556 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern option) =
# 114 "<standard.mly>"
( None )
-# 25564 "parsing/parser.ml"
+# 25574 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern option) = let x =
# 183 "<standard.mly>"
( x )
-# 25596 "parsing/parser.ml"
+# 25606 "parsing/parser.ml"
in
# 116 "<standard.mly>"
( Some x )
-# 25601 "parsing/parser.ml"
+# 25611 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression option) =
# 114 "<standard.mly>"
( None )
-# 25619 "parsing/parser.ml"
+# 25629 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression option) = let x =
# 183 "<standard.mly>"
( x )
-# 25651 "parsing/parser.ml"
+# 25661 "parsing/parser.ml"
in
# 116 "<standard.mly>"
( Some x )
-# 25656 "parsing/parser.ml"
+# 25666 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : ((Parsetree.core_type option * Parsetree.core_type option) option) =
# 114 "<standard.mly>"
( None )
-# 25674 "parsing/parser.ml"
+# 25684 "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 )
-# 25699 "parsing/parser.ml"
+# 25709 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 664 "parsing/parser.mly"
+# 668 "parsing/parser.mly"
(string)
-# 25720 "parsing/parser.ml"
+# 25730 "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) =
-# 3645 "parsing/parser.mly"
+# 3661 "parsing/parser.mly"
( _1 )
-# 25728 "parsing/parser.ml"
+# 25738 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 25762 "parsing/parser.ml"
+# 25772 "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) =
-# 3646 "parsing/parser.mly"
+# 3662 "parsing/parser.mly"
( _2 )
-# 25771 "parsing/parser.ml"
+# 25781 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1249 "parsing/parser.mly"
+# 1253 "parsing/parser.mly"
( mkmod ~loc:_sloc (Pmod_constraint(me, mty)) )
-# 25827 "parsing/parser.ml"
+# 25837 "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
-# 1251 "parsing/parser.mly"
+# 1255 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__5_ )
-# 25882 "parsing/parser.ml"
+# 25892 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.module_expr) =
-# 1254 "parsing/parser.mly"
+# 1258 "parsing/parser.mly"
( me (* TODO consider reloc *) )
-# 25921 "parsing/parser.ml"
+# 25931 "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
-# 1256 "parsing/parser.mly"
+# 1260 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__3_ )
-# 25962 "parsing/parser.ml"
+# 25972 "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 =
-# 1273 "parsing/parser.mly"
+# 1277 "parsing/parser.mly"
( e )
-# 26015 "parsing/parser.ml"
+# 26025 "parsing/parser.ml"
in
let attrs =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 26022 "parsing/parser.ml"
+# 26032 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1260 "parsing/parser.mly"
+# 1264 "parsing/parser.mly"
( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
-# 26031 "parsing/parser.ml"
+# 26041 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
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 ty =
- let _1 =
- let _1 =
-# 3320 "parsing/parser.mly"
- ( Ptyp_package (package_type_of_module_type _1) )
-# 26102 "parsing/parser.ml"
- in
- let _endpos = _endpos__1_ in
- let _symbolstartpos = _startpos__1_ in
- let _sloc = (_symbolstartpos, _endpos) in
-
-# 850 "parsing/parser.mly"
- ( mktyp ~loc:_sloc _1 )
-# 26110 "parsing/parser.ml"
-
- in
+ let _endpos = _endpos__1_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
-# 3321 "parsing/parser.mly"
- ( _1 )
+# 3335 "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 )
# 26116 "parsing/parser.ml"
in
let _startpos = _startpos_e_ in
let _loc = (_startpos, _endpos) in
-# 1275 "parsing/parser.mly"
+# 1279 "parsing/parser.mly"
( ghexp ~loc:_loc (Pexp_constraint (e, ty)) )
# 26126 "parsing/parser.ml"
let attrs =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
# 26134 "parsing/parser.ml"
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1260 "parsing/parser.mly"
+# 1264 "parsing/parser.mly"
( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
# 26143 "parsing/parser.ml"
in
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 ty2 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
- let _1 =
- let _1 =
-# 3320 "parsing/parser.mly"
- ( Ptyp_package (package_type_of_module_type _1) )
-# 26229 "parsing/parser.ml"
- in
- let _endpos = _endpos__1_ in
- let _symbolstartpos = _startpos__1_ in
- let _sloc = (_symbolstartpos, _endpos) in
-
-# 850 "parsing/parser.mly"
- ( mktyp ~loc:_sloc _1 )
-# 26237 "parsing/parser.ml"
-
- in
+ let _endpos = _endpos__1_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
-# 3321 "parsing/parser.mly"
- ( _1 )
-# 26243 "parsing/parser.ml"
+# 3335 "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 )
+# 26233 "parsing/parser.ml"
in
let _endpos_ty2_ = _endpos__1_inlined1_ in
let ty1 =
- let _1 =
- let _1 =
-# 3320 "parsing/parser.mly"
- ( Ptyp_package (package_type_of_module_type _1) )
-# 26252 "parsing/parser.ml"
- in
- let _endpos = _endpos__1_ in
- let _symbolstartpos = _startpos__1_ in
- let _sloc = (_symbolstartpos, _endpos) in
-
-# 850 "parsing/parser.mly"
- ( mktyp ~loc:_sloc _1 )
-# 26260 "parsing/parser.ml"
-
- in
+ let _endpos = _endpos__1_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
-# 3321 "parsing/parser.mly"
- ( _1 )
-# 26266 "parsing/parser.ml"
+# 3335 "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 )
+# 26246 "parsing/parser.ml"
in
let _endpos = _endpos_ty2_ in
let _startpos = _startpos_e_ in
let _loc = (_startpos, _endpos) in
-# 1277 "parsing/parser.mly"
+# 1281 "parsing/parser.mly"
( ghexp ~loc:_loc (Pexp_coerce (e, Some ty1, ty2)) )
-# 26275 "parsing/parser.ml"
+# 26255 "parsing/parser.ml"
in
let attrs =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 26283 "parsing/parser.ml"
+# 26263 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1260 "parsing/parser.mly"
+# 1264 "parsing/parser.mly"
( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
-# 26292 "parsing/parser.ml"
+# 26272 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
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 ty2 =
- let _1 =
- let _1 =
-# 3320 "parsing/parser.mly"
- ( Ptyp_package (package_type_of_module_type _1) )
-# 26363 "parsing/parser.ml"
- in
- let _endpos = _endpos__1_ in
- let _symbolstartpos = _startpos__1_ in
- let _sloc = (_symbolstartpos, _endpos) in
-
-# 850 "parsing/parser.mly"
- ( mktyp ~loc:_sloc _1 )
-# 26371 "parsing/parser.ml"
-
- in
+ let _endpos = _endpos__1_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
-# 3321 "parsing/parser.mly"
- ( _1 )
-# 26377 "parsing/parser.ml"
+# 3335 "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 )
+# 26347 "parsing/parser.ml"
in
let _endpos_ty2_ = _endpos__1_ in
let _startpos = _startpos_e_ in
let _loc = (_startpos, _endpos) in
-# 1279 "parsing/parser.mly"
+# 1283 "parsing/parser.mly"
( ghexp ~loc:_loc (Pexp_coerce (e, None, ty2)) )
-# 26387 "parsing/parser.ml"
+# 26357 "parsing/parser.ml"
in
let attrs =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 26395 "parsing/parser.ml"
+# 26365 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1260 "parsing/parser.mly"
+# 1264 "parsing/parser.mly"
( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
-# 26404 "parsing/parser.ml"
+# 26374 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_expr) = let _3 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 26466 "parsing/parser.ml"
+# 26436 "parsing/parser.ml"
in
let _loc__6_ = (_startpos__6_, _endpos__6_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1262 "parsing/parser.mly"
+# 1266 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__6_ )
-# 26474 "parsing/parser.ml"
+# 26444 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_expr) = let _3 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 26536 "parsing/parser.ml"
+# 26506 "parsing/parser.ml"
in
let _loc__6_ = (_startpos__6_, _endpos__6_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1264 "parsing/parser.mly"
+# 1268 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__6_ )
-# 26544 "parsing/parser.ml"
+# 26514 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_expr) = let _3 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 26599 "parsing/parser.ml"
+# 26569 "parsing/parser.ml"
in
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1266 "parsing/parser.mly"
+# 1270 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__5_ )
-# 26607 "parsing/parser.ml"
+# 26577 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (
-# 801 "parsing/parser.mly"
+# 805 "parsing/parser.mly"
(Longident.t)
-# 26639 "parsing/parser.ml"
+# 26609 "parsing/parser.ml"
) =
-# 1170 "parsing/parser.mly"
+# 1174 "parsing/parser.mly"
( _1 )
-# 26643 "parsing/parser.ml"
+# 26613 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (
-# 791 "parsing/parser.mly"
+# 795 "parsing/parser.mly"
(Longident.t)
-# 26675 "parsing/parser.ml"
+# 26645 "parsing/parser.ml"
) =
-# 1155 "parsing/parser.mly"
+# 1159 "parsing/parser.mly"
( _1 )
-# 26679 "parsing/parser.ml"
+# 26649 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (
-# 785 "parsing/parser.mly"
+# 789 "parsing/parser.mly"
(Parsetree.core_type)
-# 26711 "parsing/parser.ml"
+# 26681 "parsing/parser.ml"
) =
-# 1130 "parsing/parser.mly"
+# 1134 "parsing/parser.mly"
( _1 )
-# 26715 "parsing/parser.ml"
+# 26685 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (
-# 787 "parsing/parser.mly"
+# 791 "parsing/parser.mly"
(Parsetree.expression)
-# 26747 "parsing/parser.ml"
+# 26717 "parsing/parser.ml"
) =
-# 1135 "parsing/parser.mly"
+# 1139 "parsing/parser.mly"
( _1 )
-# 26751 "parsing/parser.ml"
+# 26721 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (
-# 797 "parsing/parser.mly"
+# 801 "parsing/parser.mly"
(Longident.t)
-# 26783 "parsing/parser.ml"
+# 26753 "parsing/parser.ml"
) =
-# 1160 "parsing/parser.mly"
+# 1164 "parsing/parser.mly"
( _1 )
-# 26787 "parsing/parser.ml"
+# 26757 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (
-# 799 "parsing/parser.mly"
+# 803 "parsing/parser.mly"
(Longident.t)
-# 26819 "parsing/parser.ml"
+# 26789 "parsing/parser.ml"
) =
-# 1165 "parsing/parser.mly"
+# 1169 "parsing/parser.mly"
( _1 )
-# 26823 "parsing/parser.ml"
+# 26793 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (
-# 795 "parsing/parser.mly"
+# 799 "parsing/parser.mly"
(Longident.t)
-# 26855 "parsing/parser.ml"
+# 26825 "parsing/parser.ml"
) =
-# 1145 "parsing/parser.mly"
+# 1149 "parsing/parser.mly"
( _1 )
-# 26859 "parsing/parser.ml"
+# 26829 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (
-# 789 "parsing/parser.mly"
+# 793 "parsing/parser.mly"
(Parsetree.pattern)
-# 26891 "parsing/parser.ml"
+# 26861 "parsing/parser.ml"
) =
-# 1140 "parsing/parser.mly"
+# 1144 "parsing/parser.mly"
( _1 )
-# 26895 "parsing/parser.ml"
+# 26865 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (
-# 793 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
(Longident.t)
-# 26927 "parsing/parser.ml"
+# 26897 "parsing/parser.ml"
) =
-# 1150 "parsing/parser.mly"
+# 1154 "parsing/parser.mly"
( _1 )
-# 26931 "parsing/parser.ml"
+# 26901 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__2_ = (_startpos__2_, _endpos__2_) in
let _sloc = (_symbolstartpos, _endpos) in
-# 2631 "parsing/parser.mly"
+# 2633 "parsing/parser.mly"
( mkpat_cons ~loc:_sloc _loc__2_ (ghpat ~loc:_sloc (Ppat_tuple[_1;_3])) )
-# 26975 "parsing/parser.ml"
+# 26945 "parsing/parser.ml"
in
-# 2619 "parsing/parser.mly"
+# 2621 "parsing/parser.mly"
( _1 )
-# 26981 "parsing/parser.ml"
+# 26951 "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 =
-# 2633 "parsing/parser.mly"
+# 2635 "parsing/parser.mly"
( Pat.attr _1 _2 )
-# 27013 "parsing/parser.ml"
+# 26983 "parsing/parser.ml"
in
-# 2619 "parsing/parser.mly"
+# 2621 "parsing/parser.mly"
( _1 )
-# 27018 "parsing/parser.ml"
+# 26988 "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 =
-# 2635 "parsing/parser.mly"
+# 2637 "parsing/parser.mly"
( _1 )
-# 27043 "parsing/parser.ml"
+# 27013 "parsing/parser.ml"
in
-# 2619 "parsing/parser.mly"
+# 2621 "parsing/parser.mly"
( _1 )
-# 27048 "parsing/parser.ml"
+# 27018 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 27095 "parsing/parser.ml"
+# 27065 "parsing/parser.ml"
in
-# 2638 "parsing/parser.mly"
+# 2640 "parsing/parser.mly"
( Ppat_alias(_1, _3) )
-# 27101 "parsing/parser.ml"
+# 27071 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 27111 "parsing/parser.ml"
+# 27081 "parsing/parser.ml"
in
-# 2649 "parsing/parser.mly"
+# 2651 "parsing/parser.mly"
( _1 )
-# 27117 "parsing/parser.ml"
+# 27087 "parsing/parser.ml"
in
-# 2619 "parsing/parser.mly"
+# 2621 "parsing/parser.mly"
( _1 )
-# 27123 "parsing/parser.ml"
+# 27093 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2640 "parsing/parser.mly"
+# 2642 "parsing/parser.mly"
( expecting _loc__3_ "identifier" )
-# 27166 "parsing/parser.ml"
+# 27136 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 27176 "parsing/parser.ml"
+# 27146 "parsing/parser.ml"
in
-# 2649 "parsing/parser.mly"
+# 2651 "parsing/parser.mly"
( _1 )
-# 27182 "parsing/parser.ml"
+# 27152 "parsing/parser.ml"
in
-# 2619 "parsing/parser.mly"
+# 2621 "parsing/parser.mly"
( _1 )
-# 27188 "parsing/parser.ml"
+# 27158 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _1 =
-# 2642 "parsing/parser.mly"
+# 2644 "parsing/parser.mly"
( Ppat_tuple(List.rev _1) )
-# 27215 "parsing/parser.ml"
+# 27185 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 27223 "parsing/parser.ml"
+# 27193 "parsing/parser.ml"
in
-# 2649 "parsing/parser.mly"
+# 2651 "parsing/parser.mly"
( _1 )
-# 27229 "parsing/parser.ml"
+# 27199 "parsing/parser.ml"
in
-# 2619 "parsing/parser.mly"
+# 2621 "parsing/parser.mly"
( _1 )
-# 27235 "parsing/parser.ml"
+# 27205 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2644 "parsing/parser.mly"
+# 2646 "parsing/parser.mly"
( expecting _loc__3_ "pattern" )
-# 27278 "parsing/parser.ml"
+# 27248 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 27288 "parsing/parser.ml"
+# 27258 "parsing/parser.ml"
in
-# 2649 "parsing/parser.mly"
+# 2651 "parsing/parser.mly"
( _1 )
-# 27294 "parsing/parser.ml"
+# 27264 "parsing/parser.ml"
in
-# 2619 "parsing/parser.mly"
+# 2621 "parsing/parser.mly"
( _1 )
-# 27300 "parsing/parser.ml"
+# 27270 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _1 =
-# 2646 "parsing/parser.mly"
+# 2648 "parsing/parser.mly"
( Ppat_or(_1, _3) )
-# 27341 "parsing/parser.ml"
+# 27311 "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
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 27350 "parsing/parser.ml"
+# 27320 "parsing/parser.ml"
in
-# 2649 "parsing/parser.mly"
+# 2651 "parsing/parser.mly"
( _1 )
-# 27356 "parsing/parser.ml"
+# 27326 "parsing/parser.ml"
in
-# 2619 "parsing/parser.mly"
+# 2621 "parsing/parser.mly"
( _1 )
-# 27362 "parsing/parser.ml"
+# 27332 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2648 "parsing/parser.mly"
+# 2650 "parsing/parser.mly"
( expecting _loc__3_ "pattern" )
-# 27405 "parsing/parser.ml"
+# 27375 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 27415 "parsing/parser.ml"
+# 27385 "parsing/parser.ml"
in
-# 2649 "parsing/parser.mly"
+# 2651 "parsing/parser.mly"
( _1 )
-# 27421 "parsing/parser.ml"
+# 27391 "parsing/parser.ml"
in
-# 2619 "parsing/parser.mly"
+# 2621 "parsing/parser.mly"
( _1 )
-# 27427 "parsing/parser.ml"
+# 27397 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 27477 "parsing/parser.ml"
+# 27447 "parsing/parser.ml"
in
-# 3742 "parsing/parser.mly"
+# 3758 "parsing/parser.mly"
( _1, _2 )
-# 27483 "parsing/parser.ml"
+# 27453 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2621 "parsing/parser.mly"
+# 2623 "parsing/parser.mly"
( mkpat_attrs ~loc:_sloc (Ppat_exception _3) _2)
-# 27492 "parsing/parser.ml"
+# 27462 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern list) =
-# 2745 "parsing/parser.mly"
+# 2747 "parsing/parser.mly"
( _3 :: _1 )
-# 27531 "parsing/parser.ml"
+# 27501 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern list) =
-# 2746 "parsing/parser.mly"
+# 2748 "parsing/parser.mly"
( [_3; _1] )
-# 27570 "parsing/parser.ml"
+# 27540 "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
-# 2747 "parsing/parser.mly"
+# 2749 "parsing/parser.mly"
( expecting _loc__3_ "pattern" )
-# 27610 "parsing/parser.ml"
+# 27580 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern list) =
-# 2745 "parsing/parser.mly"
+# 2747 "parsing/parser.mly"
( _3 :: _1 )
-# 27649 "parsing/parser.ml"
+# 27619 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern list) =
-# 2746 "parsing/parser.mly"
+# 2748 "parsing/parser.mly"
( [_3; _1] )
-# 27688 "parsing/parser.ml"
+# 27658 "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
-# 2747 "parsing/parser.mly"
+# 2749 "parsing/parser.mly"
( expecting _loc__3_ "pattern" )
-# 27728 "parsing/parser.ml"
+# 27698 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) =
-# 2654 "parsing/parser.mly"
+# 2656 "parsing/parser.mly"
( _1 )
-# 27753 "parsing/parser.ml"
+# 27723 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 27791 "parsing/parser.ml"
+# 27761 "parsing/parser.ml"
in
-# 2657 "parsing/parser.mly"
+# 2659 "parsing/parser.mly"
( Ppat_construct(_1, Some _2) )
-# 27797 "parsing/parser.ml"
+# 27767 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 27807 "parsing/parser.ml"
+# 27777 "parsing/parser.ml"
in
-# 2660 "parsing/parser.mly"
+# 2662 "parsing/parser.mly"
( _1 )
-# 27813 "parsing/parser.ml"
+# 27783 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2659 "parsing/parser.mly"
+# 2661 "parsing/parser.mly"
( Ppat_variant(_1, Some _2) )
-# 27846 "parsing/parser.ml"
+# 27816 "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
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 27855 "parsing/parser.ml"
+# 27825 "parsing/parser.ml"
in
-# 2660 "parsing/parser.mly"
+# 2662 "parsing/parser.mly"
( _1 )
-# 27861 "parsing/parser.ml"
+# 27831 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 27911 "parsing/parser.ml"
+# 27881 "parsing/parser.ml"
in
-# 3742 "parsing/parser.mly"
+# 3758 "parsing/parser.mly"
( _1, _2 )
-# 27917 "parsing/parser.ml"
+# 27887 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2662 "parsing/parser.mly"
+# 2664 "parsing/parser.mly"
( mkpat_attrs ~loc:_sloc (Ppat_lazy _3) _2)
-# 27926 "parsing/parser.ml"
+# 27896 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__2_ = (_startpos__2_, _endpos__2_) in
let _sloc = (_symbolstartpos, _endpos) in
-# 2631 "parsing/parser.mly"
+# 2633 "parsing/parser.mly"
( mkpat_cons ~loc:_sloc _loc__2_ (ghpat ~loc:_sloc (Ppat_tuple[_1;_3])) )
-# 27970 "parsing/parser.ml"
+# 27940 "parsing/parser.ml"
in
-# 2626 "parsing/parser.mly"
+# 2628 "parsing/parser.mly"
( _1 )
-# 27976 "parsing/parser.ml"
+# 27946 "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 =
-# 2633 "parsing/parser.mly"
+# 2635 "parsing/parser.mly"
( Pat.attr _1 _2 )
-# 28008 "parsing/parser.ml"
+# 27978 "parsing/parser.ml"
in
-# 2626 "parsing/parser.mly"
+# 2628 "parsing/parser.mly"
( _1 )
-# 28013 "parsing/parser.ml"
+# 27983 "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 =
-# 2635 "parsing/parser.mly"
+# 2637 "parsing/parser.mly"
( _1 )
-# 28038 "parsing/parser.ml"
+# 28008 "parsing/parser.ml"
in
-# 2626 "parsing/parser.mly"
+# 2628 "parsing/parser.mly"
( _1 )
-# 28043 "parsing/parser.ml"
+# 28013 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 28090 "parsing/parser.ml"
+# 28060 "parsing/parser.ml"
in
-# 2638 "parsing/parser.mly"
+# 2640 "parsing/parser.mly"
( Ppat_alias(_1, _3) )
-# 28096 "parsing/parser.ml"
+# 28066 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 28106 "parsing/parser.ml"
+# 28076 "parsing/parser.ml"
in
-# 2649 "parsing/parser.mly"
+# 2651 "parsing/parser.mly"
( _1 )
-# 28112 "parsing/parser.ml"
+# 28082 "parsing/parser.ml"
in
-# 2626 "parsing/parser.mly"
+# 2628 "parsing/parser.mly"
( _1 )
-# 28118 "parsing/parser.ml"
+# 28088 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2640 "parsing/parser.mly"
+# 2642 "parsing/parser.mly"
( expecting _loc__3_ "identifier" )
-# 28161 "parsing/parser.ml"
+# 28131 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 28171 "parsing/parser.ml"
+# 28141 "parsing/parser.ml"
in
-# 2649 "parsing/parser.mly"
+# 2651 "parsing/parser.mly"
( _1 )
-# 28177 "parsing/parser.ml"
+# 28147 "parsing/parser.ml"
in
-# 2626 "parsing/parser.mly"
+# 2628 "parsing/parser.mly"
( _1 )
-# 28183 "parsing/parser.ml"
+# 28153 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _1 =
-# 2642 "parsing/parser.mly"
+# 2644 "parsing/parser.mly"
( Ppat_tuple(List.rev _1) )
-# 28210 "parsing/parser.ml"
+# 28180 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 28218 "parsing/parser.ml"
+# 28188 "parsing/parser.ml"
in
-# 2649 "parsing/parser.mly"
+# 2651 "parsing/parser.mly"
( _1 )
-# 28224 "parsing/parser.ml"
+# 28194 "parsing/parser.ml"
in
-# 2626 "parsing/parser.mly"
+# 2628 "parsing/parser.mly"
( _1 )
-# 28230 "parsing/parser.ml"
+# 28200 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2644 "parsing/parser.mly"
+# 2646 "parsing/parser.mly"
( expecting _loc__3_ "pattern" )
-# 28273 "parsing/parser.ml"
+# 28243 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 28283 "parsing/parser.ml"
+# 28253 "parsing/parser.ml"
in
-# 2649 "parsing/parser.mly"
+# 2651 "parsing/parser.mly"
( _1 )
-# 28289 "parsing/parser.ml"
+# 28259 "parsing/parser.ml"
in
-# 2626 "parsing/parser.mly"
+# 2628 "parsing/parser.mly"
( _1 )
-# 28295 "parsing/parser.ml"
+# 28265 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _1 =
-# 2646 "parsing/parser.mly"
+# 2648 "parsing/parser.mly"
( Ppat_or(_1, _3) )
-# 28336 "parsing/parser.ml"
+# 28306 "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
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 28345 "parsing/parser.ml"
+# 28315 "parsing/parser.ml"
in
-# 2649 "parsing/parser.mly"
+# 2651 "parsing/parser.mly"
( _1 )
-# 28351 "parsing/parser.ml"
+# 28321 "parsing/parser.ml"
in
-# 2626 "parsing/parser.mly"
+# 2628 "parsing/parser.mly"
( _1 )
-# 28357 "parsing/parser.ml"
+# 28327 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2648 "parsing/parser.mly"
+# 2650 "parsing/parser.mly"
( expecting _loc__3_ "pattern" )
-# 28400 "parsing/parser.ml"
+# 28370 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 28410 "parsing/parser.ml"
+# 28380 "parsing/parser.ml"
in
-# 2649 "parsing/parser.mly"
+# 2651 "parsing/parser.mly"
( _1 )
-# 28416 "parsing/parser.ml"
+# 28386 "parsing/parser.ml"
in
-# 2626 "parsing/parser.mly"
+# 2628 "parsing/parser.mly"
( _1 )
-# 28422 "parsing/parser.ml"
+# 28392 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 28443 "parsing/parser.ml"
+# 28413 "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
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 28457 "parsing/parser.ml"
+# 28427 "parsing/parser.ml"
in
-# 2104 "parsing/parser.mly"
+# 2110 "parsing/parser.mly"
( Ppat_var _1 )
-# 28463 "parsing/parser.ml"
+# 28433 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 28472 "parsing/parser.ml"
+# 28442 "parsing/parser.ml"
in
-# 2106 "parsing/parser.mly"
+# 2112 "parsing/parser.mly"
( _1 )
-# 28478 "parsing/parser.ml"
+# 28448 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2105 "parsing/parser.mly"
+# 2111 "parsing/parser.mly"
( Ppat_any )
-# 28504 "parsing/parser.ml"
+# 28474 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 28512 "parsing/parser.ml"
+# 28482 "parsing/parser.ml"
in
-# 2106 "parsing/parser.mly"
+# 2112 "parsing/parser.mly"
( _1 )
-# 28518 "parsing/parser.ml"
+# 28488 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.payload) =
-# 3755 "parsing/parser.mly"
+# 3771 "parsing/parser.mly"
( PStr _1 )
-# 28543 "parsing/parser.ml"
+# 28513 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.payload) =
-# 3756 "parsing/parser.mly"
+# 3772 "parsing/parser.mly"
( PSig _2 )
-# 28575 "parsing/parser.ml"
+# 28545 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.payload) =
-# 3757 "parsing/parser.mly"
+# 3773 "parsing/parser.mly"
( PTyp _2 )
-# 28607 "parsing/parser.ml"
+# 28577 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.payload) =
-# 3758 "parsing/parser.mly"
+# 3774 "parsing/parser.mly"
( PPat (_2, None) )
-# 28639 "parsing/parser.ml"
+# 28609 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (Parsetree.payload) =
-# 3759 "parsing/parser.mly"
+# 3775 "parsing/parser.mly"
( PPat (_2, Some _4) )
-# 28685 "parsing/parser.ml"
+# 28655 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) =
-# 3158 "parsing/parser.mly"
+# 3174 "parsing/parser.mly"
( _1 )
-# 28710 "parsing/parser.ml"
+# 28680 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 28753 "parsing/parser.ml"
+# 28723 "parsing/parser.ml"
in
-# 915 "parsing/parser.mly"
+# 919 "parsing/parser.mly"
( xs )
-# 28758 "parsing/parser.ml"
+# 28728 "parsing/parser.ml"
in
-# 3150 "parsing/parser.mly"
+# 3166 "parsing/parser.mly"
( _1 )
-# 28764 "parsing/parser.ml"
+# 28734 "parsing/parser.ml"
in
-# 3154 "parsing/parser.mly"
+# 3170 "parsing/parser.mly"
( Ptyp_poly(_1, _3) )
-# 28770 "parsing/parser.ml"
+# 28740 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__3_, _startpos_xs_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 854 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 28780 "parsing/parser.ml"
+# 28750 "parsing/parser.ml"
in
-# 3160 "parsing/parser.mly"
+# 3176 "parsing/parser.mly"
( _1 )
-# 28786 "parsing/parser.ml"
+# 28756 "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 =
-# 3189 "parsing/parser.mly"
+# 3205 "parsing/parser.mly"
( _1 )
-# 28811 "parsing/parser.ml"
+# 28781 "parsing/parser.ml"
in
-# 3158 "parsing/parser.mly"
+# 3174 "parsing/parser.mly"
( _1 )
-# 28816 "parsing/parser.ml"
+# 28786 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.core_type) = let _1 =
let _1 =
let _3 =
-# 3189 "parsing/parser.mly"
+# 3205 "parsing/parser.mly"
( _1 )
-# 28857 "parsing/parser.ml"
+# 28827 "parsing/parser.ml"
in
let _1 =
let _1 =
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 28864 "parsing/parser.ml"
+# 28834 "parsing/parser.ml"
in
-# 915 "parsing/parser.mly"
+# 919 "parsing/parser.mly"
( xs )
-# 28869 "parsing/parser.ml"
+# 28839 "parsing/parser.ml"
in
-# 3150 "parsing/parser.mly"
+# 3166 "parsing/parser.mly"
( _1 )
-# 28875 "parsing/parser.ml"
+# 28845 "parsing/parser.ml"
in
-# 3154 "parsing/parser.mly"
+# 3170 "parsing/parser.mly"
( Ptyp_poly(_1, _3) )
-# 28881 "parsing/parser.ml"
+# 28851 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_xs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 854 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 28891 "parsing/parser.ml"
+# 28861 "parsing/parser.ml"
in
-# 3160 "parsing/parser.mly"
+# 3176 "parsing/parser.mly"
( _1 )
-# 28897 "parsing/parser.ml"
+# 28867 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3718 "parsing/parser.mly"
+# 3734 "parsing/parser.mly"
( Attr.mk ~loc:(make_loc _sloc) _2 _3 )
-# 28946 "parsing/parser.ml"
+# 28916 "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
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 29029 "parsing/parser.ml"
+# 28999 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 29041 "parsing/parser.ml"
+# 29011 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 29049 "parsing/parser.ml"
+# 29019 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2806 "parsing/parser.mly"
+# 2811 "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 )
-# 29062 "parsing/parser.ml"
+# 29032 "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 =
-# 3586 "parsing/parser.mly"
+# 3602 "parsing/parser.mly"
( Public )
-# 29080 "parsing/parser.ml"
+# 29050 "parsing/parser.ml"
in
-# 3583 "parsing/parser.mly"
+# 3599 "parsing/parser.mly"
( _1 )
-# 29085 "parsing/parser.ml"
+# 29055 "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 =
-# 3587 "parsing/parser.mly"
+# 3603 "parsing/parser.mly"
( Private )
-# 29110 "parsing/parser.ml"
+# 29080 "parsing/parser.ml"
in
-# 3583 "parsing/parser.mly"
+# 3599 "parsing/parser.mly"
( _1 )
-# 29115 "parsing/parser.ml"
+# 29085 "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) =
-# 3609 "parsing/parser.mly"
+# 3625 "parsing/parser.mly"
( Public, Concrete )
-# 29133 "parsing/parser.ml"
+# 29103 "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) =
-# 3610 "parsing/parser.mly"
+# 3626 "parsing/parser.mly"
( Private, Concrete )
-# 29158 "parsing/parser.ml"
+# 29128 "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) =
-# 3611 "parsing/parser.mly"
+# 3627 "parsing/parser.mly"
( Public, Virtual )
-# 29183 "parsing/parser.ml"
+# 29153 "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) =
-# 3612 "parsing/parser.mly"
+# 3628 "parsing/parser.mly"
( Private, Virtual )
-# 29215 "parsing/parser.ml"
+# 29185 "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) =
-# 3613 "parsing/parser.mly"
+# 3629 "parsing/parser.mly"
( Private, Virtual )
-# 29247 "parsing/parser.ml"
+# 29217 "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) =
-# 3566 "parsing/parser.mly"
+# 3582 "parsing/parser.mly"
( Nonrecursive )
-# 29265 "parsing/parser.ml"
+# 29235 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.rec_flag) =
-# 3567 "parsing/parser.mly"
+# 3583 "parsing/parser.mly"
( Recursive )
-# 29290 "parsing/parser.ml"
+# 29260 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
(Longident.t Asttypes.loc * Parsetree.expression) list) = let eo =
# 124 "<standard.mly>"
( None )
-# 29316 "parsing/parser.ml"
+# 29286 "parsing/parser.ml"
in
-# 2551 "parsing/parser.mly"
+# 2553 "parsing/parser.mly"
( eo, fields )
-# 29321 "parsing/parser.ml"
+# 29291 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let x =
# 191 "<standard.mly>"
( x )
-# 29362 "parsing/parser.ml"
+# 29332 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 29367 "parsing/parser.ml"
+# 29337 "parsing/parser.ml"
in
-# 2551 "parsing/parser.mly"
+# 2553 "parsing/parser.mly"
( eo, fields )
-# 29373 "parsing/parser.ml"
+# 29343 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_d_ in
let _endpos = _endpos_d_ in
let _v : (Parsetree.constructor_declaration list) = let x =
-# 2980 "parsing/parser.mly"
+# 2996 "parsing/parser.mly"
(
let cid, args, res, attrs, loc, info = d in
Type.constructor cid ~args ?res ~attrs ~loc ~info
)
-# 29403 "parsing/parser.ml"
+# 29373 "parsing/parser.ml"
in
-# 1025 "parsing/parser.mly"
+# 1029 "parsing/parser.mly"
( [x] )
-# 29408 "parsing/parser.ml"
+# 29378 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_d_ in
let _endpos = _endpos_d_ in
let _v : (Parsetree.constructor_declaration list) = let x =
-# 2980 "parsing/parser.mly"
+# 2996 "parsing/parser.mly"
(
let cid, args, res, attrs, loc, info = d in
Type.constructor cid ~args ?res ~attrs ~loc ~info
)
-# 29438 "parsing/parser.ml"
+# 29408 "parsing/parser.ml"
in
-# 1028 "parsing/parser.mly"
+# 1032 "parsing/parser.mly"
( [x] )
-# 29443 "parsing/parser.ml"
+# 29413 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_d_ in
let _v : (Parsetree.constructor_declaration list) = let x =
-# 2980 "parsing/parser.mly"
+# 2996 "parsing/parser.mly"
(
let cid, args, res, attrs, loc, info = d in
Type.constructor cid ~args ?res ~attrs ~loc ~info
)
-# 29480 "parsing/parser.ml"
+# 29450 "parsing/parser.ml"
in
-# 1032 "parsing/parser.mly"
+# 1036 "parsing/parser.mly"
( x :: xs )
-# 29485 "parsing/parser.ml"
+# 29455 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_d_ in
let _v : (Parsetree.extension_constructor list) = let x =
let _1 =
-# 3092 "parsing/parser.mly"
+# 3108 "parsing/parser.mly"
(
let cid, args, res, attrs, loc, info = d in
Te.decl cid ~args ?res ~attrs ~loc ~info
)
-# 29516 "parsing/parser.ml"
+# 29486 "parsing/parser.ml"
in
-# 3086 "parsing/parser.mly"
+# 3102 "parsing/parser.mly"
( _1 )
-# 29521 "parsing/parser.ml"
+# 29491 "parsing/parser.ml"
in
-# 1025 "parsing/parser.mly"
+# 1029 "parsing/parser.mly"
( [x] )
-# 29527 "parsing/parser.ml"
+# 29497 "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 =
-# 3088 "parsing/parser.mly"
+# 3104 "parsing/parser.mly"
( _1 )
-# 29552 "parsing/parser.ml"
+# 29522 "parsing/parser.ml"
in
-# 1025 "parsing/parser.mly"
+# 1029 "parsing/parser.mly"
( [x] )
-# 29557 "parsing/parser.ml"
+# 29527 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_d_ in
let _v : (Parsetree.extension_constructor list) = let x =
let _1 =
-# 3092 "parsing/parser.mly"
+# 3108 "parsing/parser.mly"
(
let cid, args, res, attrs, loc, info = d in
Te.decl cid ~args ?res ~attrs ~loc ~info
)
-# 29588 "parsing/parser.ml"
+# 29558 "parsing/parser.ml"
in
-# 3086 "parsing/parser.mly"
+# 3102 "parsing/parser.mly"
( _1 )
-# 29593 "parsing/parser.ml"
+# 29563 "parsing/parser.ml"
in
-# 1028 "parsing/parser.mly"
+# 1032 "parsing/parser.mly"
( [x] )
-# 29599 "parsing/parser.ml"
+# 29569 "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 =
-# 3088 "parsing/parser.mly"
+# 3104 "parsing/parser.mly"
( _1 )
-# 29624 "parsing/parser.ml"
+# 29594 "parsing/parser.ml"
in
-# 1028 "parsing/parser.mly"
+# 1032 "parsing/parser.mly"
( [x] )
-# 29629 "parsing/parser.ml"
+# 29599 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_d_ in
let _v : (Parsetree.extension_constructor list) = let x =
let _1 =
-# 3092 "parsing/parser.mly"
+# 3108 "parsing/parser.mly"
(
let cid, args, res, attrs, loc, info = d in
Te.decl cid ~args ?res ~attrs ~loc ~info
)
-# 29667 "parsing/parser.ml"
+# 29637 "parsing/parser.ml"
in
-# 3086 "parsing/parser.mly"
+# 3102 "parsing/parser.mly"
( _1 )
-# 29672 "parsing/parser.ml"
+# 29642 "parsing/parser.ml"
in
-# 1032 "parsing/parser.mly"
+# 1036 "parsing/parser.mly"
( x :: xs )
-# 29678 "parsing/parser.ml"
+# 29648 "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 =
-# 3088 "parsing/parser.mly"
+# 3104 "parsing/parser.mly"
( _1 )
-# 29710 "parsing/parser.ml"
+# 29680 "parsing/parser.ml"
in
-# 1032 "parsing/parser.mly"
+# 1036 "parsing/parser.mly"
( x :: xs )
-# 29715 "parsing/parser.ml"
+# 29685 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_d_ in
let _endpos = _endpos_d_ in
let _v : (Parsetree.extension_constructor list) = let x =
-# 3092 "parsing/parser.mly"
+# 3108 "parsing/parser.mly"
(
let cid, args, res, attrs, loc, info = d in
Te.decl cid ~args ?res ~attrs ~loc ~info
)
-# 29745 "parsing/parser.ml"
+# 29715 "parsing/parser.ml"
in
-# 1025 "parsing/parser.mly"
+# 1029 "parsing/parser.mly"
( [x] )
-# 29750 "parsing/parser.ml"
+# 29720 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_d_ in
let _endpos = _endpos_d_ in
let _v : (Parsetree.extension_constructor list) = let x =
-# 3092 "parsing/parser.mly"
+# 3108 "parsing/parser.mly"
(
let cid, args, res, attrs, loc, info = d in
Te.decl cid ~args ?res ~attrs ~loc ~info
)
-# 29780 "parsing/parser.ml"
+# 29750 "parsing/parser.ml"
in
-# 1028 "parsing/parser.mly"
+# 1032 "parsing/parser.mly"
( [x] )
-# 29785 "parsing/parser.ml"
+# 29755 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_d_ in
let _v : (Parsetree.extension_constructor list) = let x =
-# 3092 "parsing/parser.mly"
+# 3108 "parsing/parser.mly"
(
let cid, args, res, attrs, loc, info = d in
Te.decl cid ~args ?res ~attrs ~loc ~info
)
-# 29822 "parsing/parser.ml"
+# 29792 "parsing/parser.ml"
in
-# 1032 "parsing/parser.mly"
+# 1036 "parsing/parser.mly"
( x :: xs )
-# 29827 "parsing/parser.ml"
+# 29797 "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) =
-# 891 "parsing/parser.mly"
+# 895 "parsing/parser.mly"
( [] )
-# 29845 "parsing/parser.ml"
+# 29815 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1984 "parsing/parser.mly"
+# 1990 "parsing/parser.mly"
( _1, _3, make_loc _sloc )
-# 29904 "parsing/parser.ml"
+# 29874 "parsing/parser.ml"
in
# 183 "<standard.mly>"
( x )
-# 29910 "parsing/parser.ml"
+# 29880 "parsing/parser.ml"
in
-# 893 "parsing/parser.mly"
+# 897 "parsing/parser.mly"
( x :: xs )
-# 29916 "parsing/parser.ml"
+# 29886 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos_x_;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
- let x : (Parsetree.functor_parameter) = Obj.magic x in
+ let x : (Lexing.position * Parsetree.functor_parameter) = Obj.magic x in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
- let _v : (Parsetree.functor_parameter list) =
-# 905 "parsing/parser.mly"
+ let _v : ((Lexing.position * Parsetree.functor_parameter) list) =
+# 909 "parsing/parser.mly"
( [ x ] )
-# 29941 "parsing/parser.ml"
+# 29911 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
};
} = _menhir_stack in
- let x : (Parsetree.functor_parameter) = Obj.magic x in
- let xs : (Parsetree.functor_parameter list) = Obj.magic xs in
+ let x : (Lexing.position * Parsetree.functor_parameter) = Obj.magic x in
+ let xs : ((Lexing.position * Parsetree.functor_parameter) list) = Obj.magic xs in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
- let _v : (Parsetree.functor_parameter list) =
-# 907 "parsing/parser.mly"
+ let _v : ((Lexing.position * Parsetree.functor_parameter) list) =
+# 911 "parsing/parser.mly"
( x :: xs )
-# 29973 "parsing/parser.ml"
+# 29943 "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) =
-# 905 "parsing/parser.mly"
+# 909 "parsing/parser.mly"
( [ x ] )
-# 29998 "parsing/parser.ml"
+# 29968 "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) =
-# 907 "parsing/parser.mly"
+# 911 "parsing/parser.mly"
( x :: xs )
-# 30030 "parsing/parser.ml"
+# 30000 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : (Asttypes.label list) =
-# 905 "parsing/parser.mly"
+# 909 "parsing/parser.mly"
( [ x ] )
-# 30055 "parsing/parser.ml"
+# 30025 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Asttypes.label list) =
-# 907 "parsing/parser.mly"
+# 911 "parsing/parser.mly"
( x :: xs )
-# 30087 "parsing/parser.ml"
+# 30057 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 30125 "parsing/parser.ml"
+# 30095 "parsing/parser.ml"
in
-# 3146 "parsing/parser.mly"
+# 3162 "parsing/parser.mly"
( _2 )
-# 30131 "parsing/parser.ml"
+# 30101 "parsing/parser.ml"
in
-# 905 "parsing/parser.mly"
+# 909 "parsing/parser.mly"
( [ x ] )
-# 30137 "parsing/parser.ml"
+# 30107 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 30182 "parsing/parser.ml"
+# 30152 "parsing/parser.ml"
in
-# 3146 "parsing/parser.mly"
+# 3162 "parsing/parser.mly"
( _2 )
-# 30188 "parsing/parser.ml"
+# 30158 "parsing/parser.ml"
in
-# 907 "parsing/parser.mly"
+# 911 "parsing/parser.mly"
( x :: xs )
-# 30194 "parsing/parser.ml"
+# 30164 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.case list) = let _1 =
# 124 "<standard.mly>"
( None )
-# 30219 "parsing/parser.ml"
+# 30189 "parsing/parser.ml"
in
-# 996 "parsing/parser.mly"
+# 1000 "parsing/parser.mly"
( [x] )
-# 30224 "parsing/parser.ml"
+# 30194 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
# 126 "<standard.mly>"
( Some x )
-# 30258 "parsing/parser.ml"
+# 30228 "parsing/parser.ml"
in
-# 996 "parsing/parser.mly"
+# 1000 "parsing/parser.mly"
( [x] )
-# 30264 "parsing/parser.ml"
+# 30234 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.case list) =
-# 1000 "parsing/parser.mly"
+# 1004 "parsing/parser.mly"
( x :: xs )
-# 30303 "parsing/parser.ml"
+# 30273 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type list) = let xs =
let x =
-# 3189 "parsing/parser.mly"
+# 3205 "parsing/parser.mly"
( _1 )
-# 30329 "parsing/parser.ml"
+# 30299 "parsing/parser.ml"
in
-# 931 "parsing/parser.mly"
+# 935 "parsing/parser.mly"
( [ x ] )
-# 30334 "parsing/parser.ml"
+# 30304 "parsing/parser.ml"
in
-# 939 "parsing/parser.mly"
+# 943 "parsing/parser.mly"
( xs )
-# 30340 "parsing/parser.ml"
+# 30310 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type list) = let xs =
let x =
-# 3189 "parsing/parser.mly"
+# 3205 "parsing/parser.mly"
( _1 )
-# 30380 "parsing/parser.ml"
+# 30350 "parsing/parser.ml"
in
-# 935 "parsing/parser.mly"
+# 939 "parsing/parser.mly"
( x :: xs )
-# 30385 "parsing/parser.ml"
+# 30355 "parsing/parser.ml"
in
-# 939 "parsing/parser.mly"
+# 943 "parsing/parser.mly"
( xs )
-# 30391 "parsing/parser.ml"
+# 30361 "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 =
-# 931 "parsing/parser.mly"
+# 935 "parsing/parser.mly"
( [ x ] )
-# 30416 "parsing/parser.ml"
+# 30386 "parsing/parser.ml"
in
-# 939 "parsing/parser.mly"
+# 943 "parsing/parser.mly"
( xs )
-# 30421 "parsing/parser.ml"
+# 30391 "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 =
-# 935 "parsing/parser.mly"
+# 939 "parsing/parser.mly"
( x :: xs )
-# 30460 "parsing/parser.ml"
+# 30430 "parsing/parser.ml"
in
-# 939 "parsing/parser.mly"
+# 943 "parsing/parser.mly"
( xs )
-# 30465 "parsing/parser.ml"
+# 30435 "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 =
-# 931 "parsing/parser.mly"
+# 935 "parsing/parser.mly"
( [ x ] )
-# 30490 "parsing/parser.ml"
+# 30460 "parsing/parser.ml"
in
-# 939 "parsing/parser.mly"
+# 943 "parsing/parser.mly"
( xs )
-# 30495 "parsing/parser.ml"
+# 30465 "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 =
-# 935 "parsing/parser.mly"
+# 939 "parsing/parser.mly"
( x :: xs )
-# 30534 "parsing/parser.ml"
+# 30504 "parsing/parser.ml"
in
-# 939 "parsing/parser.mly"
+# 943 "parsing/parser.mly"
( xs )
-# 30539 "parsing/parser.ml"
+# 30509 "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 =
-# 931 "parsing/parser.mly"
+# 935 "parsing/parser.mly"
( [ x ] )
-# 30564 "parsing/parser.ml"
+# 30534 "parsing/parser.ml"
in
-# 939 "parsing/parser.mly"
+# 943 "parsing/parser.mly"
( xs )
-# 30569 "parsing/parser.ml"
+# 30539 "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 =
-# 935 "parsing/parser.mly"
+# 939 "parsing/parser.mly"
( x :: xs )
-# 30608 "parsing/parser.ml"
+# 30578 "parsing/parser.ml"
in
-# 939 "parsing/parser.mly"
+# 943 "parsing/parser.mly"
( xs )
-# 30613 "parsing/parser.ml"
+# 30583 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos_x_;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
- let x : (Parsetree.core_type * Asttypes.variance) = Obj.magic x in
+ let x : (Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) = 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 : ((Parsetree.core_type * Asttypes.variance) list) = let xs =
-# 931 "parsing/parser.mly"
+ let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = let xs =
+# 935 "parsing/parser.mly"
( [ x ] )
-# 30638 "parsing/parser.ml"
+# 30608 "parsing/parser.ml"
in
-# 939 "parsing/parser.mly"
+# 943 "parsing/parser.mly"
( xs )
-# 30643 "parsing/parser.ml"
+# 30613 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
};
} = _menhir_stack in
- let x : (Parsetree.core_type * Asttypes.variance) = Obj.magic x in
+ let x : (Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) = Obj.magic x in
let _2 : unit = Obj.magic _2 in
- let xs : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic xs in
+ let xs : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic xs in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
- let _v : ((Parsetree.core_type * Asttypes.variance) list) = let xs =
-# 935 "parsing/parser.mly"
+ let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = let xs =
+# 939 "parsing/parser.mly"
( x :: xs )
-# 30682 "parsing/parser.ml"
+# 30652 "parsing/parser.ml"
in
-# 939 "parsing/parser.mly"
+# 943 "parsing/parser.mly"
( xs )
-# 30687 "parsing/parser.ml"
+# 30657 "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 =
-# 931 "parsing/parser.mly"
+# 935 "parsing/parser.mly"
( [ x ] )
-# 30712 "parsing/parser.ml"
+# 30682 "parsing/parser.ml"
in
-# 939 "parsing/parser.mly"
+# 943 "parsing/parser.mly"
( xs )
-# 30717 "parsing/parser.ml"
+# 30687 "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 =
-# 935 "parsing/parser.mly"
+# 939 "parsing/parser.mly"
( x :: xs )
-# 30756 "parsing/parser.ml"
+# 30726 "parsing/parser.ml"
in
-# 939 "parsing/parser.mly"
+# 943 "parsing/parser.mly"
( xs )
-# 30761 "parsing/parser.ml"
+# 30731 "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) =
-# 962 "parsing/parser.mly"
+# 966 "parsing/parser.mly"
( x :: xs )
-# 30800 "parsing/parser.ml"
+# 30770 "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) =
-# 966 "parsing/parser.mly"
+# 970 "parsing/parser.mly"
( [ x2; x1 ] )
-# 30839 "parsing/parser.ml"
+# 30809 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.expression list) =
-# 962 "parsing/parser.mly"
+# 966 "parsing/parser.mly"
( x :: xs )
-# 30878 "parsing/parser.ml"
+# 30848 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x1_ in
let _endpos = _endpos_x2_ in
let _v : (Parsetree.expression list) =
-# 966 "parsing/parser.mly"
+# 970 "parsing/parser.mly"
( [ x2; x1 ] )
-# 30917 "parsing/parser.ml"
+# 30887 "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) =
-# 962 "parsing/parser.mly"
+# 966 "parsing/parser.mly"
( x :: xs )
-# 30956 "parsing/parser.ml"
+# 30926 "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) =
-# 966 "parsing/parser.mly"
+# 970 "parsing/parser.mly"
( [ x2; x1 ] )
-# 30995 "parsing/parser.ml"
+# 30965 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.row_field) =
-# 3329 "parsing/parser.mly"
+# 3345 "parsing/parser.mly"
( _1 )
-# 31020 "parsing/parser.ml"
+# 30990 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3331 "parsing/parser.mly"
+# 3347 "parsing/parser.mly"
( Rf.inherit_ ~loc:(make_loc _sloc) _1 )
-# 31048 "parsing/parser.ml"
+# 31018 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression list) = let _2 =
# 124 "<standard.mly>"
( None )
-# 31073 "parsing/parser.ml"
+# 31043 "parsing/parser.ml"
in
-# 983 "parsing/parser.mly"
+# 987 "parsing/parser.mly"
( [x] )
-# 31078 "parsing/parser.ml"
+# 31048 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
# 126 "<standard.mly>"
( Some x )
-# 31112 "parsing/parser.ml"
+# 31082 "parsing/parser.ml"
in
-# 983 "parsing/parser.mly"
+# 987 "parsing/parser.mly"
( [x] )
-# 31118 "parsing/parser.ml"
+# 31088 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_xs_ in
let _v : (Parsetree.expression list) =
-# 987 "parsing/parser.mly"
+# 991 "parsing/parser.mly"
( x :: xs )
-# 31157 "parsing/parser.ml"
+# 31127 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let oe : (Parsetree.expression option) = Obj.magic oe in
let _1 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 31185 "parsing/parser.ml"
+# 31155 "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 )
-# 31193 "parsing/parser.ml"
+# 31163 "parsing/parser.ml"
in
let x =
let label =
let _1 =
-# 3393 "parsing/parser.mly"
+# 3409 "parsing/parser.mly"
( _1 )
-# 31200 "parsing/parser.ml"
+# 31170 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 31208 "parsing/parser.ml"
+# 31178 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2574 "parsing/parser.mly"
+# 2576 "parsing/parser.mly"
( let e =
match oe with
| None ->
e
in
label, e )
-# 31226 "parsing/parser.ml"
+# 31196 "parsing/parser.ml"
in
-# 983 "parsing/parser.mly"
+# 987 "parsing/parser.mly"
( [x] )
-# 31232 "parsing/parser.ml"
+# 31202 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let x : unit = Obj.magic x in
let oe : (Parsetree.expression option) = Obj.magic oe in
let _1 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 31267 "parsing/parser.ml"
+# 31237 "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 )
-# 31275 "parsing/parser.ml"
+# 31245 "parsing/parser.ml"
in
let x =
let label =
let _1 =
-# 3393 "parsing/parser.mly"
+# 3409 "parsing/parser.mly"
( _1 )
-# 31282 "parsing/parser.ml"
+# 31252 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 31290 "parsing/parser.ml"
+# 31260 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2574 "parsing/parser.mly"
+# 2576 "parsing/parser.mly"
( let e =
match oe with
| None ->
e
in
label, e )
-# 31308 "parsing/parser.ml"
+# 31278 "parsing/parser.ml"
in
-# 983 "parsing/parser.mly"
+# 987 "parsing/parser.mly"
( [x] )
-# 31314 "parsing/parser.ml"
+# 31284 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : unit = Obj.magic _2 in
let oe : (Parsetree.expression option) = Obj.magic oe in
let _1 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 31356 "parsing/parser.ml"
+# 31326 "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 =
-# 3393 "parsing/parser.mly"
+# 3409 "parsing/parser.mly"
( _1 )
-# 31366 "parsing/parser.ml"
+# 31336 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 31374 "parsing/parser.ml"
+# 31344 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2574 "parsing/parser.mly"
+# 2576 "parsing/parser.mly"
( let e =
match oe with
| None ->
e
in
label, e )
-# 31392 "parsing/parser.ml"
+# 31362 "parsing/parser.ml"
in
-# 987 "parsing/parser.mly"
+# 991 "parsing/parser.mly"
( x :: xs )
-# 31398 "parsing/parser.ml"
+# 31368 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern list) = let _2 =
# 124 "<standard.mly>"
( None )
-# 31423 "parsing/parser.ml"
+# 31393 "parsing/parser.ml"
in
-# 983 "parsing/parser.mly"
+# 987 "parsing/parser.mly"
( [x] )
-# 31428 "parsing/parser.ml"
+# 31398 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
# 126 "<standard.mly>"
( Some x )
-# 31462 "parsing/parser.ml"
+# 31432 "parsing/parser.ml"
in
-# 983 "parsing/parser.mly"
+# 987 "parsing/parser.mly"
( [x] )
-# 31468 "parsing/parser.ml"
+# 31438 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_xs_ in
let _v : (Parsetree.pattern list) =
-# 987 "parsing/parser.mly"
+# 991 "parsing/parser.mly"
( x :: xs )
-# 31507 "parsing/parser.ml"
+# 31477 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : ((Longident.t Asttypes.loc * Parsetree.expression) list) = let _2 =
# 124 "<standard.mly>"
( None )
-# 31546 "parsing/parser.ml"
+# 31516 "parsing/parser.ml"
in
let x =
let label =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 31556 "parsing/parser.ml"
+# 31526 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2557 "parsing/parser.mly"
+# 2559 "parsing/parser.mly"
( let e =
match eo with
| None ->
e
in
label, mkexp_opt_constraint ~loc:_sloc e c )
-# 31574 "parsing/parser.ml"
+# 31544 "parsing/parser.ml"
in
-# 983 "parsing/parser.mly"
+# 987 "parsing/parser.mly"
( [x] )
-# 31580 "parsing/parser.ml"
+# 31550 "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 )
-# 31626 "parsing/parser.ml"
+# 31596 "parsing/parser.ml"
in
let x =
let label =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 31636 "parsing/parser.ml"
+# 31606 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2557 "parsing/parser.mly"
+# 2559 "parsing/parser.mly"
( let e =
match eo with
| None ->
e
in
label, mkexp_opt_constraint ~loc:_sloc e c )
-# 31654 "parsing/parser.ml"
+# 31624 "parsing/parser.ml"
in
-# 983 "parsing/parser.mly"
+# 987 "parsing/parser.mly"
( [x] )
-# 31660 "parsing/parser.ml"
+# 31630 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 31718 "parsing/parser.ml"
+# 31688 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2557 "parsing/parser.mly"
+# 2559 "parsing/parser.mly"
( let e =
match eo with
| None ->
e
in
label, mkexp_opt_constraint ~loc:_sloc e c )
-# 31736 "parsing/parser.ml"
+# 31706 "parsing/parser.ml"
in
-# 987 "parsing/parser.mly"
+# 991 "parsing/parser.mly"
( x :: xs )
-# 31742 "parsing/parser.ml"
+# 31712 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression) =
-# 2073 "parsing/parser.mly"
+# 2079 "parsing/parser.mly"
( _1 )
-# 31767 "parsing/parser.ml"
+# 31737 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) =
-# 2074 "parsing/parser.mly"
+# 2080 "parsing/parser.mly"
( _1 )
-# 31799 "parsing/parser.ml"
+# 31769 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2076 "parsing/parser.mly"
+# 2082 "parsing/parser.mly"
( Pexp_sequence(_1, _3) )
-# 31839 "parsing/parser.ml"
+# 31809 "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
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 31848 "parsing/parser.ml"
+# 31818 "parsing/parser.ml"
in
-# 2077 "parsing/parser.mly"
+# 2083 "parsing/parser.mly"
( _1 )
-# 31854 "parsing/parser.ml"
+# 31824 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2079 "parsing/parser.mly"
+# 2085 "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)) )
-# 31912 "parsing/parser.ml"
+# 31882 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.type_exception * string Asttypes.loc option) = let attrs =
let _1 = _1_inlined4 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 31981 "parsing/parser.ml"
+# 31951 "parsing/parser.ml"
in
let _endpos_attrs_ = _endpos__1_inlined4_ in
let attrs2 =
let _1 = _1_inlined3 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 31990 "parsing/parser.ml"
+# 31960 "parsing/parser.ml"
in
+ let _endpos_attrs2_ = _endpos__1_inlined3_ 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
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 32001 "parsing/parser.ml"
+# 31972 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 32009 "parsing/parser.ml"
+# 31980 "parsing/parser.ml"
in
let _endpos = _endpos_attrs_ in
+ let _startpos = _startpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3010 "parsing/parser.mly"
+# 3026 "parsing/parser.mly"
( let args, res = args_res in
- let loc = make_loc _sloc 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)
, ext )
-# 32023 "parsing/parser.ml"
+# 31995 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
# 260 "<standard.mly>"
( List.flatten xss )
-# 32049 "parsing/parser.ml"
+# 32021 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 806 "parsing/parser.mly"
+# 810 "parsing/parser.mly"
( extra_sig _startpos _endpos _1 )
-# 32057 "parsing/parser.ml"
+# 32029 "parsing/parser.ml"
in
-# 1542 "parsing/parser.mly"
+# 1547 "parsing/parser.mly"
( _1 )
-# 32063 "parsing/parser.ml"
+# 32035 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.signature_item) = let _2 =
let _1 = _1_inlined1 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 32097 "parsing/parser.ml"
+# 32069 "parsing/parser.ml"
in
let _endpos__2_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1557 "parsing/parser.mly"
+# 1562 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mksig ~loc:_sloc (Psig_extension (_1, (add_docs_attrs docs _2))) )
-# 32108 "parsing/parser.ml"
+# 32080 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1561 "parsing/parser.mly"
+# 1566 "parsing/parser.mly"
( Psig_attribute _1 )
-# 32134 "parsing/parser.ml"
+# 32106 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 854 "parsing/parser.mly"
+# 858 "parsing/parser.mly"
( mksig ~loc:_sloc _1 )
-# 32142 "parsing/parser.ml"
+# 32114 "parsing/parser.ml"
in
-# 1563 "parsing/parser.mly"
+# 1568 "parsing/parser.mly"
( _1 )
-# 32148 "parsing/parser.ml"
+# 32120 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1566 "parsing/parser.mly"
+# 1571 "parsing/parser.mly"
( psig_value _1 )
-# 32174 "parsing/parser.ml"
+# 32146 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 871 "parsing/parser.mly"
+# 875 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 32182 "parsing/parser.ml"
+# 32154 "parsing/parser.ml"
in
-# 1596 "parsing/parser.mly"
+# 1601 "parsing/parser.mly"
( _1 )
-# 32188 "parsing/parser.ml"
+# 32160 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1568 "parsing/parser.mly"
+# 1573 "parsing/parser.mly"
( psig_value _1 )
-# 32214 "parsing/parser.ml"
+# 32186 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 871 "parsing/parser.mly"
+# 875 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 32222 "parsing/parser.ml"
+# 32194 "parsing/parser.ml"
in
-# 1596 "parsing/parser.mly"
+# 1601 "parsing/parser.mly"
( _1 )
-# 32228 "parsing/parser.ml"
+# 32200 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _1 =
let _1 =
-# 1044 "parsing/parser.mly"
+# 1048 "parsing/parser.mly"
( let (x, b) = a in x, b :: bs )
-# 32265 "parsing/parser.ml"
+# 32237 "parsing/parser.ml"
in
-# 2842 "parsing/parser.mly"
+# 2847 "parsing/parser.mly"
( _1 )
-# 32270 "parsing/parser.ml"
+# 32242 "parsing/parser.ml"
in
-# 2825 "parsing/parser.mly"
+# 2830 "parsing/parser.mly"
( _1 )
-# 32276 "parsing/parser.ml"
+# 32248 "parsing/parser.ml"
in
-# 1570 "parsing/parser.mly"
+# 1575 "parsing/parser.mly"
( psig_type _1 )
-# 32282 "parsing/parser.ml"
+# 32254 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_bs_, _startpos_a_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 871 "parsing/parser.mly"
+# 875 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 32292 "parsing/parser.ml"
+# 32264 "parsing/parser.ml"
in
-# 1596 "parsing/parser.mly"
+# 1601 "parsing/parser.mly"
( _1 )
-# 32298 "parsing/parser.ml"
+# 32270 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _1 =
let _1 =
-# 1044 "parsing/parser.mly"
+# 1048 "parsing/parser.mly"
( let (x, b) = a in x, b :: bs )
-# 32335 "parsing/parser.ml"
+# 32307 "parsing/parser.ml"
in
-# 2842 "parsing/parser.mly"
+# 2847 "parsing/parser.mly"
( _1 )
-# 32340 "parsing/parser.ml"
+# 32312 "parsing/parser.ml"
in
-# 2830 "parsing/parser.mly"
+# 2835 "parsing/parser.mly"
( _1 )
-# 32346 "parsing/parser.ml"
+# 32318 "parsing/parser.ml"
in
-# 1572 "parsing/parser.mly"
+# 1577 "parsing/parser.mly"
( psig_typesubst _1 )
-# 32352 "parsing/parser.ml"
+# 32324 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_bs_, _startpos_a_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 871 "parsing/parser.mly"
+# 875 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 32362 "parsing/parser.ml"
+# 32334 "parsing/parser.ml"
in
-# 1596 "parsing/parser.mly"
+# 1601 "parsing/parser.mly"
( _1 )
-# 32368 "parsing/parser.ml"
+# 32340 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let priv : (Asttypes.private_flag) = Obj.magic priv in
let _7 : unit = Obj.magic _7 in
let _1_inlined2 : (Longident.t) = Obj.magic _1_inlined2 in
- let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params 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 ext : (string Asttypes.loc option) = Obj.magic ext in
let _1 : unit = Obj.magic _1 in
let attrs2 =
let _1 = _1_inlined3 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 32455 "parsing/parser.ml"
+# 32427 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let cs =
-# 1036 "parsing/parser.mly"
+# 1040 "parsing/parser.mly"
( List.rev xs )
-# 32462 "parsing/parser.ml"
+# 32434 "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
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 32472 "parsing/parser.ml"
+# 32444 "parsing/parser.ml"
in
let _4 =
-# 3574 "parsing/parser.mly"
+# 3590 "parsing/parser.mly"
( Recursive )
-# 32478 "parsing/parser.ml"
+# 32450 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 32485 "parsing/parser.ml"
+# 32457 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3079 "parsing/parser.mly"
+# 3095 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
let attrs = attrs1 @ attrs2 in
Te.mk tid cs ~params ~priv ~attrs ~docs,
ext )
-# 32497 "parsing/parser.ml"
+# 32469 "parsing/parser.ml"
in
-# 3066 "parsing/parser.mly"
+# 3082 "parsing/parser.mly"
( _1 )
-# 32503 "parsing/parser.ml"
+# 32475 "parsing/parser.ml"
in
-# 1574 "parsing/parser.mly"
+# 1579 "parsing/parser.mly"
( psig_typext _1 )
-# 32509 "parsing/parser.ml"
+# 32481 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 871 "parsing/parser.mly"
+# 875 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 32519 "parsing/parser.ml"
+# 32491 "parsing/parser.ml"
in
-# 1596 "parsing/parser.mly"
+# 1601 "parsing/parser.mly"
( _1 )
-# 32525 "parsing/parser.ml"
+# 32497 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let priv : (Asttypes.private_flag) = Obj.magic priv in
let _7 : unit = Obj.magic _7 in
let _1_inlined3 : (Longident.t) = Obj.magic _1_inlined3 in
- let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in
+ let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let _1_inlined2 : unit = 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 attrs2 =
let _1 = _1_inlined4 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 32619 "parsing/parser.ml"
+# 32591 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let cs =
-# 1036 "parsing/parser.mly"
+# 1040 "parsing/parser.mly"
( List.rev xs )
-# 32626 "parsing/parser.ml"
+# 32598 "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
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 32636 "parsing/parser.ml"
+# 32608 "parsing/parser.ml"
in
let _4 =
let _startpos = _startpos__1_ in
let _loc = (_startpos, _endpos) in
-# 3575 "parsing/parser.mly"
+# 3591 "parsing/parser.mly"
( not_expecting _loc "nonrec flag" )
-# 32647 "parsing/parser.ml"
+# 32619 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 32655 "parsing/parser.ml"
+# 32627 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3079 "parsing/parser.mly"
+# 3095 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
let attrs = attrs1 @ attrs2 in
Te.mk tid cs ~params ~priv ~attrs ~docs,
ext )
-# 32667 "parsing/parser.ml"
+# 32639 "parsing/parser.ml"
in
-# 3066 "parsing/parser.mly"
+# 3082 "parsing/parser.mly"
( _1 )
-# 32673 "parsing/parser.ml"
+# 32645 "parsing/parser.ml"
in
-# 1574 "parsing/parser.mly"
+# 1579 "parsing/parser.mly"
( psig_typext _1 )
-# 32679 "parsing/parser.ml"
+# 32651 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 871 "parsing/parser.mly"
+# 875 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 32689 "parsing/parser.ml"
+# 32661 "parsing/parser.ml"
in
-# 1596 "parsing/parser.mly"
+# 1601 "parsing/parser.mly"
( _1 )
-# 32695 "parsing/parser.ml"
+# 32667 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1576 "parsing/parser.mly"
+# 1581 "parsing/parser.mly"
( psig_exception _1 )
-# 32721 "parsing/parser.ml"
+# 32693 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 871 "parsing/parser.mly"
+# 875 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 32729 "parsing/parser.ml"
+# 32701 "parsing/parser.ml"
in
-# 1596 "parsing/parser.mly"
+# 1601 "parsing/parser.mly"
( _1 )
-# 32735 "parsing/parser.ml"
+# 32707 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined3 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 32800 "parsing/parser.ml"
+# 32772 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 32812 "parsing/parser.ml"
+# 32784 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 32820 "parsing/parser.ml"
+# 32792 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1605 "parsing/parser.mly"
+# 1610 "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
)
-# 32834 "parsing/parser.ml"
+# 32806 "parsing/parser.ml"
in
-# 1578 "parsing/parser.mly"
+# 1583 "parsing/parser.mly"
( let (body, ext) = _1 in (Psig_module body, ext) )
-# 32840 "parsing/parser.ml"
+# 32812 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 871 "parsing/parser.mly"
+# 875 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 32850 "parsing/parser.ml"
+# 32822 "parsing/parser.ml"
in
-# 1596 "parsing/parser.mly"
+# 1601 "parsing/parser.mly"
( _1 )
-# 32856 "parsing/parser.ml"
+# 32828 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined4 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 32928 "parsing/parser.ml"
+# 32900 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 32941 "parsing/parser.ml"
+# 32913 "parsing/parser.ml"
in
let (_endpos_id_, _startpos_id_) = (_endpos__1_, _startpos__1_) in
let _symbolstartpos = _startpos_id_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1641 "parsing/parser.mly"
+# 1647 "parsing/parser.mly"
( Mty.alias ~loc:(make_loc _sloc) id )
-# 32951 "parsing/parser.ml"
+# 32923 "parsing/parser.ml"
in
let name =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 32962 "parsing/parser.ml"
+# 32934 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 32970 "parsing/parser.ml"
+# 32942 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1632 "parsing/parser.mly"
+# 1638 "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
)
-# 32984 "parsing/parser.ml"
+# 32956 "parsing/parser.ml"
in
-# 1580 "parsing/parser.mly"
+# 1585 "parsing/parser.mly"
( let (body, ext) = _1 in (Psig_module body, ext) )
-# 32990 "parsing/parser.ml"
+# 32962 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 871 "parsing/parser.mly"
+# 875 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 33000 "parsing/parser.ml"
+# 32972 "parsing/parser.ml"
in
-# 1596 "parsing/parser.mly"
+# 1601 "parsing/parser.mly"
( _1 )
-# 33006 "parsing/parser.ml"
+# 32978 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1582 "parsing/parser.mly"
+# 1587 "parsing/parser.mly"
( let (body, ext) = _1 in (Psig_modsubst body, ext) )
-# 33032 "parsing/parser.ml"
+# 33004 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 871 "parsing/parser.mly"
+# 875 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 33040 "parsing/parser.ml"
+# 33012 "parsing/parser.ml"
in
-# 1596 "parsing/parser.mly"
+# 1601 "parsing/parser.mly"
( _1 )
-# 33046 "parsing/parser.ml"
+# 33018 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined3 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 33134 "parsing/parser.ml"
+# 33106 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 33146 "parsing/parser.ml"
+# 33118 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 33154 "parsing/parser.ml"
+# 33126 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1675 "parsing/parser.mly"
+# 1681 "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
)
-# 33168 "parsing/parser.ml"
+# 33140 "parsing/parser.ml"
in
-# 1044 "parsing/parser.mly"
+# 1048 "parsing/parser.mly"
( let (x, b) = a in x, b :: bs )
-# 33174 "parsing/parser.ml"
+# 33146 "parsing/parser.ml"
in
-# 1664 "parsing/parser.mly"
+# 1670 "parsing/parser.mly"
( _1 )
-# 33180 "parsing/parser.ml"
+# 33152 "parsing/parser.ml"
in
-# 1584 "parsing/parser.mly"
+# 1589 "parsing/parser.mly"
( let (ext, l) = _1 in (Psig_recmodule l, ext) )
-# 33186 "parsing/parser.ml"
+# 33158 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_bs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 871 "parsing/parser.mly"
+# 875 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 33196 "parsing/parser.ml"
+# 33168 "parsing/parser.ml"
in
-# 1596 "parsing/parser.mly"
+# 1601 "parsing/parser.mly"
( _1 )
-# 33202 "parsing/parser.ml"
+# 33174 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1586 "parsing/parser.mly"
+# 1591 "parsing/parser.mly"
( let (body, ext) = _1 in (Psig_modtype body, ext) )
-# 33228 "parsing/parser.ml"
+# 33200 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 871 "parsing/parser.mly"
+# 875 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 33236 "parsing/parser.ml"
+# 33208 "parsing/parser.ml"
in
-# 1596 "parsing/parser.mly"
+# 1601 "parsing/parser.mly"
( _1 )
-# 33242 "parsing/parser.ml"
+# 33214 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1588 "parsing/parser.mly"
+# 1593 "parsing/parser.mly"
( let (body, ext) = _1 in (Psig_open body, ext) )
-# 33268 "parsing/parser.ml"
+# 33240 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 871 "parsing/parser.mly"
+# 875 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 33276 "parsing/parser.ml"
+# 33248 "parsing/parser.ml"
in
-# 1596 "parsing/parser.mly"
+# 1601 "parsing/parser.mly"
( _1 )
-# 33282 "parsing/parser.ml"
+# 33254 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined2 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 33340 "parsing/parser.ml"
+# 33312 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined2_ in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 33349 "parsing/parser.ml"
+# 33321 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1434 "parsing/parser.mly"
+# 1439 "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
)
-# 33363 "parsing/parser.ml"
+# 33335 "parsing/parser.ml"
in
-# 1590 "parsing/parser.mly"
+# 1595 "parsing/parser.mly"
( psig_include _1 )
-# 33369 "parsing/parser.ml"
+# 33341 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 871 "parsing/parser.mly"
+# 875 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 33379 "parsing/parser.ml"
+# 33351 "parsing/parser.ml"
in
-# 1596 "parsing/parser.mly"
+# 1601 "parsing/parser.mly"
( _1 )
-# 33385 "parsing/parser.ml"
+# 33357 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let cty : (Parsetree.class_type) = Obj.magic cty in
let _7 : unit = Obj.magic _7 in
let _1_inlined2 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 33464 "parsing/parser.ml"
+# 33436 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
- let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params 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 _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let ext : (string Asttypes.loc option) = Obj.magic ext in
let attrs2 =
let _1 = _1_inlined3 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 33484 "parsing/parser.ml"
+# 33456 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 33496 "parsing/parser.ml"
+# 33468 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 33504 "parsing/parser.ml"
+# 33476 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2005 "parsing/parser.mly"
+# 2011 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
ext,
Ci.mk id cty ~virt ~params ~attrs ~loc ~docs
)
-# 33519 "parsing/parser.ml"
+# 33491 "parsing/parser.ml"
in
-# 1044 "parsing/parser.mly"
+# 1048 "parsing/parser.mly"
( let (x, b) = a in x, b :: bs )
-# 33525 "parsing/parser.ml"
+# 33497 "parsing/parser.ml"
in
-# 1993 "parsing/parser.mly"
+# 1999 "parsing/parser.mly"
( _1 )
-# 33531 "parsing/parser.ml"
+# 33503 "parsing/parser.ml"
in
-# 1592 "parsing/parser.mly"
+# 1597 "parsing/parser.mly"
( let (ext, l) = _1 in (Psig_class l, ext) )
-# 33537 "parsing/parser.ml"
+# 33509 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_bs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 871 "parsing/parser.mly"
+# 875 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 33547 "parsing/parser.ml"
+# 33519 "parsing/parser.ml"
in
-# 1596 "parsing/parser.mly"
+# 1601 "parsing/parser.mly"
( _1 )
-# 33553 "parsing/parser.ml"
+# 33525 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1594 "parsing/parser.mly"
+# 1599 "parsing/parser.mly"
( let (ext, l) = _1 in (Psig_class_type l, ext) )
-# 33579 "parsing/parser.ml"
+# 33551 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 871 "parsing/parser.mly"
+# 875 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 33587 "parsing/parser.ml"
+# 33559 "parsing/parser.ml"
in
-# 1596 "parsing/parser.mly"
+# 1601 "parsing/parser.mly"
( _1 )
-# 33593 "parsing/parser.ml"
+# 33565 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.constant) =
-# 3405 "parsing/parser.mly"
+# 3421 "parsing/parser.mly"
( _1 )
-# 33618 "parsing/parser.ml"
+# 33590 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _2 : (
-# 633 "parsing/parser.mly"
+# 637 "parsing/parser.mly"
(string * char option)
-# 33645 "parsing/parser.ml"
+# 33617 "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) =
-# 3406 "parsing/parser.mly"
+# 3422 "parsing/parser.mly"
( let (n, m) = _2 in Pconst_integer("-" ^ n, m) )
-# 33654 "parsing/parser.ml"
+# 33626 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _2 : (
-# 612 "parsing/parser.mly"
+# 616 "parsing/parser.mly"
(string * char option)
-# 33681 "parsing/parser.ml"
+# 33653 "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) =
-# 3407 "parsing/parser.mly"
+# 3423 "parsing/parser.mly"
( let (f, m) = _2 in Pconst_float("-" ^ f, m) )
-# 33690 "parsing/parser.ml"
+# 33662 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _2 : (
-# 633 "parsing/parser.mly"
+# 637 "parsing/parser.mly"
(string * char option)
-# 33717 "parsing/parser.ml"
+# 33689 "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) =
-# 3408 "parsing/parser.mly"
+# 3424 "parsing/parser.mly"
( let (n, m) = _2 in Pconst_integer (n, m) )
-# 33726 "parsing/parser.ml"
+# 33698 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _2 : (
-# 612 "parsing/parser.mly"
+# 616 "parsing/parser.mly"
(string * char option)
-# 33753 "parsing/parser.ml"
+# 33725 "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) =
-# 3409 "parsing/parser.mly"
+# 3425 "parsing/parser.mly"
( let (f, m) = _2 in Pconst_float(f, m) )
-# 33762 "parsing/parser.ml"
+# 33734 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 2757 "parsing/parser.mly"
+# 2759 "parsing/parser.mly"
( let fields, closed = _1 in
let closed = match closed with Some () -> Open | None -> Closed in
fields, closed )
-# 33807 "parsing/parser.ml"
+# 33779 "parsing/parser.ml"
in
-# 2728 "parsing/parser.mly"
+# 2730 "parsing/parser.mly"
( let (fields, closed) = _2 in
Ppat_record(fields, closed) )
-# 33814 "parsing/parser.ml"
+# 33786 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 33824 "parsing/parser.ml"
+# 33796 "parsing/parser.ml"
in
-# 2742 "parsing/parser.mly"
+# 2744 "parsing/parser.mly"
( _1 )
-# 33830 "parsing/parser.ml"
+# 33802 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 2757 "parsing/parser.mly"
+# 2759 "parsing/parser.mly"
( let fields, closed = _1 in
let closed = match closed with Some () -> Open | None -> Closed in
fields, closed )
-# 33875 "parsing/parser.ml"
+# 33847 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2731 "parsing/parser.mly"
+# 2733 "parsing/parser.mly"
( unclosed "{" _loc__1_ "}" _loc__3_ )
-# 33883 "parsing/parser.ml"
+# 33855 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 33893 "parsing/parser.ml"
+# 33865 "parsing/parser.ml"
in
-# 2742 "parsing/parser.mly"
+# 2744 "parsing/parser.mly"
( _1 )
-# 33899 "parsing/parser.ml"
+# 33871 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _2 =
-# 2751 "parsing/parser.mly"
+# 2753 "parsing/parser.mly"
( ps )
-# 33940 "parsing/parser.ml"
+# 33912 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2733 "parsing/parser.mly"
+# 2735 "parsing/parser.mly"
( fst (mktailpat _loc__3_ _2) )
-# 33946 "parsing/parser.ml"
+# 33918 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 33956 "parsing/parser.ml"
+# 33928 "parsing/parser.ml"
in
-# 2742 "parsing/parser.mly"
+# 2744 "parsing/parser.mly"
( _1 )
-# 33962 "parsing/parser.ml"
+# 33934 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _2 =
-# 2751 "parsing/parser.mly"
+# 2753 "parsing/parser.mly"
( ps )
-# 34003 "parsing/parser.ml"
+# 33975 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2735 "parsing/parser.mly"
+# 2737 "parsing/parser.mly"
( unclosed "[" _loc__1_ "]" _loc__3_ )
-# 34010 "parsing/parser.ml"
+# 33982 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 34020 "parsing/parser.ml"
+# 33992 "parsing/parser.ml"
in
-# 2742 "parsing/parser.mly"
+# 2744 "parsing/parser.mly"
( _1 )
-# 34026 "parsing/parser.ml"
+# 33998 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _2 =
-# 2751 "parsing/parser.mly"
+# 2753 "parsing/parser.mly"
( ps )
-# 34067 "parsing/parser.ml"
+# 34039 "parsing/parser.ml"
in
-# 2737 "parsing/parser.mly"
+# 2739 "parsing/parser.mly"
( Ppat_array _2 )
-# 34072 "parsing/parser.ml"
+# 34044 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 34082 "parsing/parser.ml"
+# 34054 "parsing/parser.ml"
in
-# 2742 "parsing/parser.mly"
+# 2744 "parsing/parser.mly"
( _1 )
-# 34088 "parsing/parser.ml"
+# 34060 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2739 "parsing/parser.mly"
+# 2741 "parsing/parser.mly"
( Ppat_array [] )
-# 34121 "parsing/parser.ml"
+# 34093 "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
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 34130 "parsing/parser.ml"
+# 34102 "parsing/parser.ml"
in
-# 2742 "parsing/parser.mly"
+# 2744 "parsing/parser.mly"
( _1 )
-# 34136 "parsing/parser.ml"
+# 34108 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _2 =
-# 2751 "parsing/parser.mly"
+# 2753 "parsing/parser.mly"
( ps )
-# 34177 "parsing/parser.ml"
+# 34149 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2741 "parsing/parser.mly"
+# 2743 "parsing/parser.mly"
( unclosed "[|" _loc__1_ "|]" _loc__3_ )
-# 34184 "parsing/parser.ml"
+# 34156 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 34194 "parsing/parser.ml"
+# 34166 "parsing/parser.ml"
in
-# 2742 "parsing/parser.mly"
+# 2744 "parsing/parser.mly"
( _1 )
-# 34200 "parsing/parser.ml"
+# 34172 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2240 "parsing/parser.mly"
+# 2246 "parsing/parser.mly"
( reloc_exp ~loc:_sloc _2 )
-# 34242 "parsing/parser.ml"
+# 34214 "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
-# 2242 "parsing/parser.mly"
+# 2248 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__3_ )
-# 34283 "parsing/parser.ml"
+# 34255 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2244 "parsing/parser.mly"
+# 2250 "parsing/parser.mly"
( mkexp_constraint ~loc:_sloc _2 _3 )
-# 34332 "parsing/parser.ml"
+# 34304 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2246 "parsing/parser.mly"
+# 2252 "parsing/parser.mly"
( array_get ~loc:_sloc _1 _4 )
-# 34388 "parsing/parser.ml"
+# 34360 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2248 "parsing/parser.mly"
+# 2254 "parsing/parser.mly"
( unclosed "(" _loc__3_ ")" _loc__5_ )
-# 34443 "parsing/parser.ml"
+# 34415 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2250 "parsing/parser.mly"
+# 2256 "parsing/parser.mly"
( string_get ~loc:_sloc _1 _4 )
-# 34499 "parsing/parser.ml"
+# 34471 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2252 "parsing/parser.mly"
+# 2258 "parsing/parser.mly"
( unclosed "[" _loc__3_ "]" _loc__5_ )
-# 34554 "parsing/parser.ml"
+# 34526 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 628 "parsing/parser.mly"
+# 632 "parsing/parser.mly"
(string)
-# 34602 "parsing/parser.ml"
+# 34574 "parsing/parser.ml"
) = Obj.magic _2 in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.expression) = let _4 =
-# 2586 "parsing/parser.mly"
+# 2588 "parsing/parser.mly"
( es )
-# 34611 "parsing/parser.ml"
+# 34583 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2254 "parsing/parser.mly"
+# 2260 "parsing/parser.mly"
( dotop_get ~loc:_sloc lident bracket _2 _1 _4 )
-# 34619 "parsing/parser.ml"
+# 34591 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 628 "parsing/parser.mly"
+# 632 "parsing/parser.mly"
(string)
-# 34667 "parsing/parser.ml"
+# 34639 "parsing/parser.ml"
) = Obj.magic _2 in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.expression) = let _4 =
-# 2586 "parsing/parser.mly"
+# 2588 "parsing/parser.mly"
( es )
-# 34676 "parsing/parser.ml"
+# 34648 "parsing/parser.ml"
in
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2256 "parsing/parser.mly"
+# 2262 "parsing/parser.mly"
( unclosed "[" _loc__3_ "]" _loc__5_ )
-# 34683 "parsing/parser.ml"
+# 34655 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 628 "parsing/parser.mly"
+# 632 "parsing/parser.mly"
(string)
-# 34731 "parsing/parser.ml"
+# 34703 "parsing/parser.ml"
) = Obj.magic _2 in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.expression) = let _4 =
-# 2586 "parsing/parser.mly"
+# 2588 "parsing/parser.mly"
( es )
-# 34740 "parsing/parser.ml"
+# 34712 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2258 "parsing/parser.mly"
+# 2264 "parsing/parser.mly"
( dotop_get ~loc:_sloc lident paren _2 _1 _4 )
-# 34748 "parsing/parser.ml"
+# 34720 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 628 "parsing/parser.mly"
+# 632 "parsing/parser.mly"
(string)
-# 34796 "parsing/parser.ml"
+# 34768 "parsing/parser.ml"
) = Obj.magic _2 in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.expression) = let _4 =
-# 2586 "parsing/parser.mly"
+# 2588 "parsing/parser.mly"
( es )
-# 34805 "parsing/parser.ml"
+# 34777 "parsing/parser.ml"
in
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2260 "parsing/parser.mly"
+# 2266 "parsing/parser.mly"
( unclosed "(" _loc__3_ ")" _loc__5_ )
-# 34812 "parsing/parser.ml"
+# 34784 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 628 "parsing/parser.mly"
+# 632 "parsing/parser.mly"
(string)
-# 34860 "parsing/parser.ml"
+# 34832 "parsing/parser.ml"
) = Obj.magic _2 in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.expression) = let _4 =
-# 2586 "parsing/parser.mly"
+# 2588 "parsing/parser.mly"
( es )
-# 34869 "parsing/parser.ml"
+# 34841 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2262 "parsing/parser.mly"
+# 2268 "parsing/parser.mly"
( dotop_get ~loc:_sloc lident brace _2 _1 _4 )
-# 34877 "parsing/parser.ml"
+# 34849 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _4 : (Parsetree.expression) = Obj.magic _4 in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 628 "parsing/parser.mly"
+# 632 "parsing/parser.mly"
(string)
-# 34925 "parsing/parser.ml"
+# 34897 "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 _v : (Parsetree.expression) = let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2264 "parsing/parser.mly"
+# 2270 "parsing/parser.mly"
( unclosed "{" _loc__3_ "}" _loc__5_ )
-# 34936 "parsing/parser.ml"
+# 34908 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let es : (Parsetree.expression list) = Obj.magic es in
let _5 : unit = Obj.magic _5 in
let _4 : (
-# 628 "parsing/parser.mly"
+# 632 "parsing/parser.mly"
(string)
-# 34996 "parsing/parser.ml"
+# 34968 "parsing/parser.ml"
) = Obj.magic _4 in
let _3 : (Longident.t) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _startpos = _startpos__1_ in
let _endpos = _endpos__7_ in
let _v : (Parsetree.expression) = let _6 =
-# 2586 "parsing/parser.mly"
+# 2588 "parsing/parser.mly"
( es )
-# 35007 "parsing/parser.ml"
+# 34979 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2266 "parsing/parser.mly"
+# 2272 "parsing/parser.mly"
( dotop_get ~loc:_sloc (ldot _3) bracket _4 _1 _6 )
-# 35015 "parsing/parser.ml"
+# 34987 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let es : (Parsetree.expression list) = Obj.magic es in
let _5 : unit = Obj.magic _5 in
let _4 : (
-# 628 "parsing/parser.mly"
+# 632 "parsing/parser.mly"
(string)
-# 35075 "parsing/parser.ml"
+# 35047 "parsing/parser.ml"
) = Obj.magic _4 in
let _3 : (Longident.t) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _startpos = _startpos__1_ in
let _endpos = _endpos__7_ in
let _v : (Parsetree.expression) = let _6 =
-# 2586 "parsing/parser.mly"
+# 2588 "parsing/parser.mly"
( es )
-# 35086 "parsing/parser.ml"
+# 35058 "parsing/parser.ml"
in
let _loc__7_ = (_startpos__7_, _endpos__7_) in
let _loc__5_ = (_startpos__5_, _endpos__5_) in
-# 2269 "parsing/parser.mly"
+# 2275 "parsing/parser.mly"
( unclosed "[" _loc__5_ "]" _loc__7_ )
-# 35093 "parsing/parser.ml"
+# 35065 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let es : (Parsetree.expression list) = Obj.magic es in
let _5 : unit = Obj.magic _5 in
let _4 : (
-# 628 "parsing/parser.mly"
+# 632 "parsing/parser.mly"
(string)
-# 35153 "parsing/parser.ml"
+# 35125 "parsing/parser.ml"
) = Obj.magic _4 in
let _3 : (Longident.t) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _startpos = _startpos__1_ in
let _endpos = _endpos__7_ in
let _v : (Parsetree.expression) = let _6 =
-# 2586 "parsing/parser.mly"
+# 2588 "parsing/parser.mly"
( es )
-# 35164 "parsing/parser.ml"
+# 35136 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2271 "parsing/parser.mly"
+# 2277 "parsing/parser.mly"
( dotop_get ~loc:_sloc (ldot _3) paren _4 _1 _6 )
-# 35172 "parsing/parser.ml"
+# 35144 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let es : (Parsetree.expression list) = Obj.magic es in
let _5 : unit = Obj.magic _5 in
let _4 : (
-# 628 "parsing/parser.mly"
+# 632 "parsing/parser.mly"
(string)
-# 35232 "parsing/parser.ml"
+# 35204 "parsing/parser.ml"
) = Obj.magic _4 in
let _3 : (Longident.t) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _startpos = _startpos__1_ in
let _endpos = _endpos__7_ in
let _v : (Parsetree.expression) = let _6 =
-# 2586 "parsing/parser.mly"
+# 2588 "parsing/parser.mly"
( es )
-# 35243 "parsing/parser.ml"
+# 35215 "parsing/parser.ml"
in
let _loc__7_ = (_startpos__7_, _endpos__7_) in
let _loc__5_ = (_startpos__5_, _endpos__5_) in
-# 2274 "parsing/parser.mly"
+# 2280 "parsing/parser.mly"
( unclosed "(" _loc__5_ ")" _loc__7_ )
-# 35250 "parsing/parser.ml"
+# 35222 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let es : (Parsetree.expression list) = Obj.magic es in
let _5 : unit = Obj.magic _5 in
let _4 : (
-# 628 "parsing/parser.mly"
+# 632 "parsing/parser.mly"
(string)
-# 35310 "parsing/parser.ml"
+# 35282 "parsing/parser.ml"
) = Obj.magic _4 in
let _3 : (Longident.t) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _startpos = _startpos__1_ in
let _endpos = _endpos__7_ in
let _v : (Parsetree.expression) = let _6 =
-# 2586 "parsing/parser.mly"
+# 2588 "parsing/parser.mly"
( es )
-# 35321 "parsing/parser.ml"
+# 35293 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2276 "parsing/parser.mly"
+# 2282 "parsing/parser.mly"
( dotop_get ~loc:_sloc (ldot _3) brace _4 _1 _6 )
-# 35329 "parsing/parser.ml"
+# 35301 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let es : (Parsetree.expression list) = Obj.magic es in
let _5 : unit = Obj.magic _5 in
let _4 : (
-# 628 "parsing/parser.mly"
+# 632 "parsing/parser.mly"
(string)
-# 35389 "parsing/parser.ml"
+# 35361 "parsing/parser.ml"
) = Obj.magic _4 in
let _3 : (Longident.t) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _startpos = _startpos__1_ in
let _endpos = _endpos__7_ in
let _v : (Parsetree.expression) = let _6 =
-# 2586 "parsing/parser.mly"
+# 2588 "parsing/parser.mly"
( es )
-# 35400 "parsing/parser.ml"
+# 35372 "parsing/parser.ml"
in
let _loc__7_ = (_startpos__7_, _endpos__7_) in
let _loc__5_ = (_startpos__5_, _endpos__5_) in
-# 2279 "parsing/parser.mly"
+# 2285 "parsing/parser.mly"
( unclosed "{" _loc__5_ "}" _loc__7_ )
-# 35407 "parsing/parser.ml"
+# 35379 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2281 "parsing/parser.mly"
+# 2287 "parsing/parser.mly"
( bigarray_get ~loc:_sloc _1 _4 )
-# 35463 "parsing/parser.ml"
+# 35435 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2283 "parsing/parser.mly"
+# 2289 "parsing/parser.mly"
( unclosed "{" _loc__3_ "}" _loc__5_ )
-# 35518 "parsing/parser.ml"
+# 35490 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 35574 "parsing/parser.ml"
+# 35546 "parsing/parser.ml"
in
-# 2292 "parsing/parser.mly"
+# 2298 "parsing/parser.mly"
( e.pexp_desc, (ext, attrs @ e.pexp_attributes) )
-# 35580 "parsing/parser.ml"
+# 35552 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2285 "parsing/parser.mly"
+# 2291 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 35591 "parsing/parser.ml"
+# 35563 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 35642 "parsing/parser.ml"
+# 35614 "parsing/parser.ml"
in
-# 3742 "parsing/parser.mly"
+# 3758 "parsing/parser.mly"
( _1, _2 )
-# 35648 "parsing/parser.ml"
+# 35620 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2294 "parsing/parser.mly"
+# 2300 "parsing/parser.mly"
( Pexp_construct (mkloc (Lident "()") (make_loc _sloc), None), _2 )
-# 35657 "parsing/parser.ml"
+# 35629 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2285 "parsing/parser.mly"
+# 2291 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 35668 "parsing/parser.ml"
+# 35640 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 35726 "parsing/parser.ml"
+# 35698 "parsing/parser.ml"
in
-# 3742 "parsing/parser.mly"
+# 3758 "parsing/parser.mly"
( _1, _2 )
-# 35732 "parsing/parser.ml"
+# 35704 "parsing/parser.ml"
in
let _loc__4_ = (_startpos__4_, _endpos__4_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2296 "parsing/parser.mly"
+# 2302 "parsing/parser.mly"
( unclosed "begin" _loc__1_ "end" _loc__4_ )
-# 35740 "parsing/parser.ml"
+# 35712 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2285 "parsing/parser.mly"
+# 2291 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 35751 "parsing/parser.ml"
+# 35723 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 35803 "parsing/parser.ml"
+# 35775 "parsing/parser.ml"
in
let _2 =
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 35813 "parsing/parser.ml"
+# 35785 "parsing/parser.ml"
in
-# 3742 "parsing/parser.mly"
+# 3758 "parsing/parser.mly"
( _1, _2 )
-# 35819 "parsing/parser.ml"
+# 35791 "parsing/parser.ml"
in
-# 2298 "parsing/parser.mly"
+# 2304 "parsing/parser.mly"
( Pexp_new(_3), _2 )
-# 35825 "parsing/parser.ml"
+# 35797 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2285 "parsing/parser.mly"
+# 2291 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 35836 "parsing/parser.ml"
+# 35808 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 35901 "parsing/parser.ml"
+# 35873 "parsing/parser.ml"
in
-# 3742 "parsing/parser.mly"
+# 3758 "parsing/parser.mly"
( _1, _2 )
-# 35907 "parsing/parser.ml"
+# 35879 "parsing/parser.ml"
in
-# 2300 "parsing/parser.mly"
+# 2306 "parsing/parser.mly"
( Pexp_pack _4, _3 )
-# 35913 "parsing/parser.ml"
+# 35885 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2285 "parsing/parser.mly"
+# 2291 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 35924 "parsing/parser.ml"
+# 35896 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _6 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
- let _1 =
- let _1 =
-# 3320 "parsing/parser.mly"
- ( Ptyp_package (package_type_of_module_type _1) )
-# 36002 "parsing/parser.ml"
- in
- let _endpos = _endpos__1_ in
- let _symbolstartpos = _startpos__1_ in
- let _sloc = (_symbolstartpos, _endpos) in
-
-# 850 "parsing/parser.mly"
- ( mktyp ~loc:_sloc _1 )
-# 36010 "parsing/parser.ml"
-
- in
+ let _endpos = _endpos__1_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
-# 3321 "parsing/parser.mly"
- ( _1 )
-# 36016 "parsing/parser.ml"
+# 3335 "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 )
+# 35978 "parsing/parser.ml"
in
let _3 =
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 36026 "parsing/parser.ml"
+# 35988 "parsing/parser.ml"
in
-# 3742 "parsing/parser.mly"
+# 3758 "parsing/parser.mly"
( _1, _2 )
-# 36032 "parsing/parser.ml"
+# 35994 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2302 "parsing/parser.mly"
+# 2308 "parsing/parser.mly"
( Pexp_constraint (ghexp ~loc:_sloc (Pexp_pack _4), _6), _3 )
-# 36041 "parsing/parser.ml"
+# 36003 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2285 "parsing/parser.mly"
+# 2291 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 36052 "parsing/parser.ml"
+# 36014 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 36124 "parsing/parser.ml"
+# 36086 "parsing/parser.ml"
in
-# 3742 "parsing/parser.mly"
+# 3758 "parsing/parser.mly"
( _1, _2 )
-# 36130 "parsing/parser.ml"
+# 36092 "parsing/parser.ml"
in
let _loc__6_ = (_startpos__6_, _endpos__6_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2304 "parsing/parser.mly"
+# 2310 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__6_ )
-# 36138 "parsing/parser.ml"
+# 36100 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2285 "parsing/parser.mly"
+# 2291 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 36149 "parsing/parser.ml"
+# 36111 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 36180 "parsing/parser.ml"
+# 36142 "parsing/parser.ml"
in
-# 2308 "parsing/parser.mly"
+# 2314 "parsing/parser.mly"
( Pexp_ident (_1) )
-# 36186 "parsing/parser.ml"
+# 36148 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36195 "parsing/parser.ml"
+# 36157 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 36201 "parsing/parser.ml"
+# 36163 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2310 "parsing/parser.mly"
+# 2316 "parsing/parser.mly"
( Pexp_constant _1 )
-# 36227 "parsing/parser.ml"
+# 36189 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36235 "parsing/parser.ml"
+# 36197 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 36241 "parsing/parser.ml"
+# 36203 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 36272 "parsing/parser.ml"
+# 36234 "parsing/parser.ml"
in
-# 2312 "parsing/parser.mly"
+# 2318 "parsing/parser.mly"
( Pexp_construct(_1, None) )
-# 36278 "parsing/parser.ml"
+# 36240 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36287 "parsing/parser.ml"
+# 36249 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 36293 "parsing/parser.ml"
+# 36255 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2314 "parsing/parser.mly"
+# 2320 "parsing/parser.mly"
( Pexp_variant(_1, None) )
-# 36319 "parsing/parser.ml"
+# 36281 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36327 "parsing/parser.ml"
+# 36289 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 36333 "parsing/parser.ml"
+# 36295 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let _2 : (Parsetree.expression) = Obj.magic _2 in
let _1 : (
-# 671 "parsing/parser.mly"
+# 675 "parsing/parser.mly"
(string)
-# 36361 "parsing/parser.ml"
+# 36323 "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
-# 840 "parsing/parser.mly"
+# 844 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 36375 "parsing/parser.ml"
+# 36337 "parsing/parser.ml"
in
-# 2316 "parsing/parser.mly"
+# 2322 "parsing/parser.mly"
( Pexp_apply(_1, [Nolabel,_2]) )
-# 36381 "parsing/parser.ml"
+# 36343 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36391 "parsing/parser.ml"
+# 36353 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 36397 "parsing/parser.ml"
+# 36359 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _1 =
let _1 =
-# 2317 "parsing/parser.mly"
+# 2323 "parsing/parser.mly"
("!")
-# 36432 "parsing/parser.ml"
+# 36394 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 840 "parsing/parser.mly"
+# 844 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 36440 "parsing/parser.ml"
+# 36402 "parsing/parser.ml"
in
-# 2318 "parsing/parser.mly"
+# 2324 "parsing/parser.mly"
( Pexp_apply(_1, [Nolabel,_2]) )
-# 36446 "parsing/parser.ml"
+# 36408 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36456 "parsing/parser.ml"
+# 36418 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 36462 "parsing/parser.ml"
+# 36424 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _2 =
-# 2569 "parsing/parser.mly"
+# 2571 "parsing/parser.mly"
( xs )
-# 36503 "parsing/parser.ml"
+# 36465 "parsing/parser.ml"
in
-# 2320 "parsing/parser.mly"
+# 2326 "parsing/parser.mly"
( Pexp_override _2 )
-# 36508 "parsing/parser.ml"
+# 36470 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36518 "parsing/parser.ml"
+# 36480 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 36524 "parsing/parser.ml"
+# 36486 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _2 =
-# 2569 "parsing/parser.mly"
+# 2571 "parsing/parser.mly"
( xs )
-# 36565 "parsing/parser.ml"
+# 36527 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2322 "parsing/parser.mly"
+# 2328 "parsing/parser.mly"
( unclosed "{<" _loc__1_ ">}" _loc__3_ )
-# 36572 "parsing/parser.ml"
+# 36534 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36582 "parsing/parser.ml"
+# 36544 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 36588 "parsing/parser.ml"
+# 36550 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2324 "parsing/parser.mly"
+# 2330 "parsing/parser.mly"
( Pexp_override [] )
-# 36621 "parsing/parser.ml"
+# 36583 "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
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36630 "parsing/parser.ml"
+# 36592 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 36636 "parsing/parser.ml"
+# 36598 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 36682 "parsing/parser.ml"
+# 36644 "parsing/parser.ml"
in
-# 2326 "parsing/parser.mly"
+# 2332 "parsing/parser.mly"
( Pexp_field(_1, _3) )
-# 36688 "parsing/parser.ml"
+# 36650 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36698 "parsing/parser.ml"
+# 36660 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 36704 "parsing/parser.ml"
+# 36666 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 36764 "parsing/parser.ml"
+# 36726 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1493 "parsing/parser.mly"
+# 1498 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 36773 "parsing/parser.ml"
+# 36735 "parsing/parser.ml"
in
-# 2328 "parsing/parser.mly"
+# 2334 "parsing/parser.mly"
( Pexp_open(od, _4) )
-# 36779 "parsing/parser.ml"
+# 36741 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36789 "parsing/parser.ml"
+# 36751 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 36795 "parsing/parser.ml"
+# 36757 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _4 =
-# 2569 "parsing/parser.mly"
+# 2571 "parsing/parser.mly"
( xs )
-# 36850 "parsing/parser.ml"
+# 36812 "parsing/parser.ml"
in
let od =
let _1 =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 36860 "parsing/parser.ml"
+# 36822 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1493 "parsing/parser.mly"
+# 1498 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 36869 "parsing/parser.ml"
+# 36831 "parsing/parser.ml"
in
let _startpos_od_ = _startpos__1_ in
let _symbolstartpos = _startpos_od_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2330 "parsing/parser.mly"
+# 2336 "parsing/parser.mly"
( (* TODO: review the location of Pexp_override *)
Pexp_open(od, mkexp ~loc:_sloc (Pexp_override _4)) )
-# 36880 "parsing/parser.ml"
+# 36842 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36890 "parsing/parser.ml"
+# 36852 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 36896 "parsing/parser.ml"
+# 36858 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _4 =
-# 2569 "parsing/parser.mly"
+# 2571 "parsing/parser.mly"
( xs )
-# 36951 "parsing/parser.ml"
+# 36913 "parsing/parser.ml"
in
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2333 "parsing/parser.mly"
+# 2339 "parsing/parser.mly"
( unclosed "{<" _loc__3_ ">}" _loc__5_ )
-# 36958 "parsing/parser.ml"
+# 36920 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36968 "parsing/parser.ml"
+# 36930 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 36974 "parsing/parser.ml"
+# 36936 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _1_inlined1 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 37007 "parsing/parser.ml"
+# 36969 "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 =
-# 3393 "parsing/parser.mly"
+# 3409 "parsing/parser.mly"
( _1 )
-# 37021 "parsing/parser.ml"
+# 36983 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 37029 "parsing/parser.ml"
+# 36991 "parsing/parser.ml"
in
-# 2335 "parsing/parser.mly"
+# 2341 "parsing/parser.mly"
( Pexp_send(_1, _3) )
-# 37035 "parsing/parser.ml"
+# 36997 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37045 "parsing/parser.ml"
+# 37007 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 37051 "parsing/parser.ml"
+# 37013 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let _3 : (Parsetree.expression) = Obj.magic _3 in
let _1_inlined1 : (
-# 682 "parsing/parser.mly"
+# 686 "parsing/parser.mly"
(string)
-# 37085 "parsing/parser.ml"
+# 37047 "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
-# 840 "parsing/parser.mly"
+# 844 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 37101 "parsing/parser.ml"
+# 37063 "parsing/parser.ml"
in
-# 2337 "parsing/parser.mly"
+# 2343 "parsing/parser.mly"
( mkinfix _1 _2 _3 )
-# 37107 "parsing/parser.ml"
+# 37069 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37117 "parsing/parser.ml"
+# 37079 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 37123 "parsing/parser.ml"
+# 37085 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2339 "parsing/parser.mly"
+# 2345 "parsing/parser.mly"
( Pexp_extension _1 )
-# 37149 "parsing/parser.ml"
+# 37111 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37157 "parsing/parser.ml"
+# 37119 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 37163 "parsing/parser.ml"
+# 37125 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 =
let (_endpos__2_, _startpos__1_, _2, _1) = (_endpos__2_inlined1_, _startpos__1_inlined1_, _2_inlined1, _1_inlined1) in
let _1 =
-# 2340 "parsing/parser.mly"
+# 2346 "parsing/parser.mly"
(Lident "()")
-# 37213 "parsing/parser.ml"
+# 37175 "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
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 37222 "parsing/parser.ml"
+# 37184 "parsing/parser.ml"
in
- let _endpos__3_ = _endpos__2_inlined1_ in
+ let (_endpos__3_, _startpos__3_) = (_endpos__2_inlined1_, _startpos__1_inlined1_) in
let od =
let _1 =
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 37234 "parsing/parser.ml"
+# 37196 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1493 "parsing/parser.mly"
+# 1498 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 37243 "parsing/parser.ml"
+# 37205 "parsing/parser.ml"
in
- let _startpos_od_ = _startpos__1_ in
- let _endpos = _endpos__3_ in
- let _symbolstartpos = _startpos_od_ in
- let _sloc = (_symbolstartpos, _endpos) in
+ let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2341 "parsing/parser.mly"
- ( (* TODO: review the location of Pexp_construct *)
- Pexp_open(od, mkexp ~loc:_sloc (Pexp_construct(_3, None))) )
-# 37254 "parsing/parser.ml"
+# 2347 "parsing/parser.mly"
+ ( Pexp_open(od, mkexp ~loc:(_loc__3_) (Pexp_construct(_3, None))) )
+# 37212 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37264 "parsing/parser.ml"
+# 37222 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 37270 "parsing/parser.ml"
+# 37228 "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
-# 2344 "parsing/parser.mly"
+# 2349 "parsing/parser.mly"
( unclosed "(" _loc__3_ ")" _loc__5_ )
-# 37327 "parsing/parser.ml"
+# 37285 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37337 "parsing/parser.ml"
+# 37295 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 37343 "parsing/parser.ml"
+# 37301 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2346 "parsing/parser.mly"
+# 2351 "parsing/parser.mly"
( let (exten, fields) = _2 in
Pexp_record(fields, exten) )
-# 37385 "parsing/parser.ml"
+# 37343 "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
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37394 "parsing/parser.ml"
+# 37352 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 37400 "parsing/parser.ml"
+# 37358 "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
-# 2349 "parsing/parser.mly"
+# 2354 "parsing/parser.mly"
( unclosed "{" _loc__1_ "}" _loc__3_ )
-# 37444 "parsing/parser.ml"
+# 37402 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37454 "parsing/parser.ml"
+# 37412 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 37460 "parsing/parser.ml"
+# 37418 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 37521 "parsing/parser.ml"
+# 37479 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1493 "parsing/parser.mly"
+# 1498 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 37530 "parsing/parser.ml"
+# 37488 "parsing/parser.ml"
in
- let _startpos_od_ = _startpos__1_ in
let _endpos = _endpos__5_ in
- let _symbolstartpos = _startpos_od_ in
- let _sloc = (_symbolstartpos, _endpos) in
-# 2351 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( let (exten, fields) = _4 in
- (* TODO: review the location of Pexp_construct *)
- Pexp_open(od, mkexp ~loc:_sloc (Pexp_record(fields, exten))) )
-# 37542 "parsing/parser.ml"
+ Pexp_open(od, mkexp ~loc:(_startpos__3_, _endpos)
+ (Pexp_record(fields, exten))) )
+# 37497 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37552 "parsing/parser.ml"
+# 37507 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 37558 "parsing/parser.ml"
+# 37513 "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
-# 2355 "parsing/parser.mly"
+# 2360 "parsing/parser.mly"
( unclosed "{" _loc__3_ "}" _loc__5_ )
-# 37616 "parsing/parser.ml"
+# 37571 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37626 "parsing/parser.ml"
+# 37581 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 37632 "parsing/parser.ml"
+# 37587 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _2 =
-# 2586 "parsing/parser.mly"
+# 2588 "parsing/parser.mly"
( es )
-# 37673 "parsing/parser.ml"
+# 37628 "parsing/parser.ml"
in
-# 2357 "parsing/parser.mly"
+# 2362 "parsing/parser.mly"
( Pexp_array(_2) )
-# 37678 "parsing/parser.ml"
+# 37633 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37688 "parsing/parser.ml"
+# 37643 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 37694 "parsing/parser.ml"
+# 37649 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _2 =
-# 2586 "parsing/parser.mly"
+# 2588 "parsing/parser.mly"
( es )
-# 37735 "parsing/parser.ml"
+# 37690 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2359 "parsing/parser.mly"
+# 2364 "parsing/parser.mly"
( unclosed "[|" _loc__1_ "|]" _loc__3_ )
-# 37742 "parsing/parser.ml"
+# 37697 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37752 "parsing/parser.ml"
+# 37707 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 37758 "parsing/parser.ml"
+# 37713 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2361 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( Pexp_array [] )
-# 37791 "parsing/parser.ml"
+# 37746 "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
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37800 "parsing/parser.ml"
+# 37755 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 37806 "parsing/parser.ml"
+# 37761 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _4 =
-# 2586 "parsing/parser.mly"
+# 2588 "parsing/parser.mly"
( es )
-# 37861 "parsing/parser.ml"
+# 37816 "parsing/parser.ml"
in
let od =
let _1 =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 37871 "parsing/parser.ml"
+# 37826 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1493 "parsing/parser.mly"
+# 1498 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 37880 "parsing/parser.ml"
+# 37835 "parsing/parser.ml"
in
- let _startpos_od_ = _startpos__1_ in
let _endpos = _endpos__5_ in
- let _symbolstartpos = _startpos_od_ in
- let _sloc = (_symbolstartpos, _endpos) in
-# 2363 "parsing/parser.mly"
- ( (* TODO: review the location of Pexp_array *)
- Pexp_open(od, mkexp ~loc:_sloc (Pexp_array(_4))) )
-# 37891 "parsing/parser.ml"
+# 2368 "parsing/parser.mly"
+ ( Pexp_open(od, mkexp ~loc:(_startpos__3_, _endpos) (Pexp_array(_4))) )
+# 37842 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37901 "parsing/parser.ml"
+# 37852 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 37907 "parsing/parser.ml"
+# 37858 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 37960 "parsing/parser.ml"
+# 37911 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1493 "parsing/parser.mly"
+# 1498 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 37969 "parsing/parser.ml"
+# 37920 "parsing/parser.ml"
in
- let _startpos_od_ = _startpos__1_ in
let _endpos = _endpos__4_ in
- let _symbolstartpos = _startpos_od_ in
- let _sloc = (_symbolstartpos, _endpos) in
-# 2366 "parsing/parser.mly"
+# 2370 "parsing/parser.mly"
( (* TODO: review the location of Pexp_array *)
- Pexp_open(od, mkexp ~loc:_sloc (Pexp_array [])) )
-# 37980 "parsing/parser.ml"
+ Pexp_open(od, mkexp ~loc:(_startpos__3_, _endpos) (Pexp_array [])) )
+# 37928 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37990 "parsing/parser.ml"
+# 37938 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 37996 "parsing/parser.ml"
+# 37944 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _4 =
-# 2586 "parsing/parser.mly"
+# 2588 "parsing/parser.mly"
( es )
-# 38051 "parsing/parser.ml"
+# 37999 "parsing/parser.ml"
in
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2370 "parsing/parser.mly"
+# 2374 "parsing/parser.mly"
( unclosed "[|" _loc__3_ "|]" _loc__5_ )
-# 38058 "parsing/parser.ml"
+# 38006 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 38068 "parsing/parser.ml"
+# 38016 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 38074 "parsing/parser.ml"
+# 38022 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _2 =
-# 2586 "parsing/parser.mly"
+# 2588 "parsing/parser.mly"
( es )
-# 38115 "parsing/parser.ml"
+# 38063 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2372 "parsing/parser.mly"
+# 2376 "parsing/parser.mly"
( fst (mktailexp _loc__3_ _2) )
-# 38121 "parsing/parser.ml"
+# 38069 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 38131 "parsing/parser.ml"
+# 38079 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 38137 "parsing/parser.ml"
+# 38085 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _2 =
-# 2586 "parsing/parser.mly"
+# 2588 "parsing/parser.mly"
( es )
-# 38178 "parsing/parser.ml"
+# 38126 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2374 "parsing/parser.mly"
+# 2378 "parsing/parser.mly"
( unclosed "[" _loc__1_ "]" _loc__3_ )
-# 38185 "parsing/parser.ml"
+# 38133 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 38195 "parsing/parser.ml"
+# 38143 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 38201 "parsing/parser.ml"
+# 38149 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _4 =
-# 2586 "parsing/parser.mly"
+# 2588 "parsing/parser.mly"
( es )
-# 38256 "parsing/parser.ml"
+# 38204 "parsing/parser.ml"
in
let od =
let _1 =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 38266 "parsing/parser.ml"
+# 38214 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1493 "parsing/parser.mly"
+# 1498 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 38275 "parsing/parser.ml"
+# 38223 "parsing/parser.ml"
in
- let _startpos_od_ = _startpos__1_ in
let _endpos = _endpos__5_ in
- let _symbolstartpos = _startpos_od_ in
let _loc__5_ = (_startpos__5_, _endpos__5_) in
- let _sloc = (_symbolstartpos, _endpos) in
-# 2376 "parsing/parser.mly"
+# 2380 "parsing/parser.mly"
( let list_exp =
(* TODO: review the location of list_exp *)
let tail_exp, _tail_loc = mktailexp _loc__5_ _4 in
- mkexp ~loc:_sloc tail_exp in
+ mkexp ~loc:(_startpos__3_, _endpos) tail_exp in
Pexp_open(od, list_exp) )
-# 38290 "parsing/parser.ml"
+# 38235 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 38300 "parsing/parser.ml"
+# 38245 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 38306 "parsing/parser.ml"
+# 38251 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 =
let (_endpos__2_, _startpos__1_, _2, _1) = (_endpos__2_inlined1_, _startpos__1_inlined1_, _2_inlined1, _1_inlined1) in
let _1 =
-# 2381 "parsing/parser.mly"
+# 2385 "parsing/parser.mly"
(Lident "[]")
-# 38356 "parsing/parser.ml"
+# 38301 "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
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 38365 "parsing/parser.ml"
+# 38310 "parsing/parser.ml"
in
- let _endpos__3_ = _endpos__2_inlined1_ in
+ let (_endpos__3_, _startpos__3_) = (_endpos__2_inlined1_, _startpos__1_inlined1_) in
let od =
let _1 =
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 38377 "parsing/parser.ml"
+# 38322 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1493 "parsing/parser.mly"
+# 1498 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 38386 "parsing/parser.ml"
+# 38331 "parsing/parser.ml"
in
- let _startpos_od_ = _startpos__1_ in
- let _endpos = _endpos__3_ in
- let _symbolstartpos = _startpos_od_ in
- let _sloc = (_symbolstartpos, _endpos) in
+ let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2382 "parsing/parser.mly"
- ( (* TODO: review the location of Pexp_construct *)
- Pexp_open(od, mkexp ~loc:_sloc (Pexp_construct(_3, None))) )
-# 38397 "parsing/parser.ml"
+# 2386 "parsing/parser.mly"
+ ( Pexp_open(od, mkexp ~loc:_loc__3_ (Pexp_construct(_3, None))) )
+# 38338 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 38407 "parsing/parser.ml"
+# 38348 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 38413 "parsing/parser.ml"
+# 38354 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _4 =
-# 2586 "parsing/parser.mly"
+# 2588 "parsing/parser.mly"
( es )
-# 38468 "parsing/parser.ml"
+# 38409 "parsing/parser.ml"
in
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2386 "parsing/parser.mly"
+# 2389 "parsing/parser.mly"
( unclosed "[" _loc__3_ "]" _loc__5_ )
-# 38475 "parsing/parser.ml"
+# 38416 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 38485 "parsing/parser.ml"
+# 38426 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 38491 "parsing/parser.ml"
+# 38432 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _8 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
- let _1 =
- let _1 =
-# 3320 "parsing/parser.mly"
- ( Ptyp_package (package_type_of_module_type _1) )
-# 38584 "parsing/parser.ml"
- in
- let _endpos = _endpos__1_ in
- let _symbolstartpos = _startpos__1_ in
- let _sloc = (_symbolstartpos, _endpos) in
-
-# 850 "parsing/parser.mly"
- ( mktyp ~loc:_sloc _1 )
-# 38592 "parsing/parser.ml"
-
- in
+ let _endpos = _endpos__1_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
-# 3321 "parsing/parser.mly"
- ( _1 )
-# 38598 "parsing/parser.ml"
+# 3335 "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 )
+# 38529 "parsing/parser.ml"
in
let _5 =
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 38608 "parsing/parser.ml"
+# 38539 "parsing/parser.ml"
in
-# 3742 "parsing/parser.mly"
+# 3758 "parsing/parser.mly"
( _1, _2 )
-# 38614 "parsing/parser.ml"
+# 38545 "parsing/parser.ml"
in
let od =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 38625 "parsing/parser.ml"
+# 38556 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1493 "parsing/parser.mly"
+# 1498 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 38634 "parsing/parser.ml"
+# 38565 "parsing/parser.ml"
in
let _startpos_od_ = _startpos__1_ in
let _symbolstartpos = _startpos_od_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2389 "parsing/parser.mly"
- ( (* TODO: review the location of Pexp_constraint *)
- let modexp =
- mkexp_attrs ~loc:_sloc
+# 2392 "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) )
-# 38648 "parsing/parser.ml"
+# 38578 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__9_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 38658 "parsing/parser.ml"
+# 38588 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 38664 "parsing/parser.ml"
+# 38594 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 38751 "parsing/parser.ml"
+# 38681 "parsing/parser.ml"
in
-# 3742 "parsing/parser.mly"
+# 3758 "parsing/parser.mly"
( _1, _2 )
-# 38757 "parsing/parser.ml"
+# 38687 "parsing/parser.ml"
in
let _loc__8_ = (_startpos__8_, _endpos__8_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2396 "parsing/parser.mly"
+# 2398 "parsing/parser.mly"
( unclosed "(" _loc__3_ ")" _loc__8_ )
-# 38765 "parsing/parser.ml"
+# 38695 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__8_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 846 "parsing/parser.mly"
+# 850 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 38775 "parsing/parser.ml"
+# 38705 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( _1 )
-# 38781 "parsing/parser.ml"
+# 38711 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 38812 "parsing/parser.ml"
+# 38742 "parsing/parser.ml"
in
-# 2666 "parsing/parser.mly"
+# 2668 "parsing/parser.mly"
( Ppat_var (_1) )
-# 38818 "parsing/parser.ml"
+# 38748 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 38827 "parsing/parser.ml"
+# 38757 "parsing/parser.ml"
in
-# 2667 "parsing/parser.mly"
+# 2669 "parsing/parser.mly"
( _1 )
-# 38833 "parsing/parser.ml"
+# 38763 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) =
-# 2668 "parsing/parser.mly"
+# 2670 "parsing/parser.mly"
( _1 )
-# 38858 "parsing/parser.ml"
+# 38788 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2673 "parsing/parser.mly"
+# 2675 "parsing/parser.mly"
( reloc_pat ~loc:_sloc _2 )
-# 38900 "parsing/parser.ml"
+# 38830 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) =
-# 2675 "parsing/parser.mly"
+# 2677 "parsing/parser.mly"
( _1 )
-# 38925 "parsing/parser.ml"
+# 38855 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 38990 "parsing/parser.ml"
+# 38920 "parsing/parser.ml"
in
let _3 =
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 39000 "parsing/parser.ml"
+# 38930 "parsing/parser.ml"
in
-# 3742 "parsing/parser.mly"
+# 3758 "parsing/parser.mly"
( _1, _2 )
-# 39006 "parsing/parser.ml"
+# 38936 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2677 "parsing/parser.mly"
+# 2679 "parsing/parser.mly"
( mkpat_attrs ~loc:_sloc (Ppat_unpack _4) _3 )
-# 39015 "parsing/parser.ml"
+# 38945 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__7_ in
let _v : (Parsetree.pattern) = let _6 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined4_, _startpos__1_inlined4_, _1_inlined4) in
- let _1 =
- let _1 =
-# 3320 "parsing/parser.mly"
- ( Ptyp_package (package_type_of_module_type _1) )
-# 39092 "parsing/parser.ml"
- in
- let _endpos = _endpos__1_ in
- let _symbolstartpos = _startpos__1_ in
- let _sloc = (_symbolstartpos, _endpos) in
-
-# 850 "parsing/parser.mly"
- ( mktyp ~loc:_sloc _1 )
-# 39100 "parsing/parser.ml"
-
- in
+ let _endpos = _endpos__1_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
-# 3321 "parsing/parser.mly"
- ( _1 )
-# 39106 "parsing/parser.ml"
+# 3335 "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 )
+# 39026 "parsing/parser.ml"
in
let _4 =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 39117 "parsing/parser.ml"
+# 39037 "parsing/parser.ml"
in
+ let (_endpos__4_, _startpos__4_) = (_endpos__1_inlined3_, _startpos__1_inlined3_) in
let _3 =
let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 39127 "parsing/parser.ml"
+# 39048 "parsing/parser.ml"
in
-# 3742 "parsing/parser.mly"
+# 3758 "parsing/parser.mly"
( _1, _2 )
-# 39133 "parsing/parser.ml"
+# 39054 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
+ let _loc__4_ = (_startpos__4_, _endpos__4_) in
let _sloc = (_symbolstartpos, _endpos) in
-# 2679 "parsing/parser.mly"
+# 2681 "parsing/parser.mly"
( mkpat_attrs ~loc:_sloc
- (Ppat_constraint(mkpat ~loc:_sloc (Ppat_unpack _4), _6))
+ (Ppat_constraint(mkpat ~loc:_loc__4_ (Ppat_unpack _4), _6))
_3 )
-# 39144 "parsing/parser.ml"
+# 39066 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2687 "parsing/parser.mly"
+# 2689 "parsing/parser.mly"
( Ppat_any )
-# 39170 "parsing/parser.ml"
+# 39092 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39178 "parsing/parser.ml"
+# 39100 "parsing/parser.ml"
in
-# 2683 "parsing/parser.mly"
+# 2685 "parsing/parser.mly"
( _1 )
-# 39184 "parsing/parser.ml"
+# 39106 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2689 "parsing/parser.mly"
+# 2691 "parsing/parser.mly"
( Ppat_constant _1 )
-# 39210 "parsing/parser.ml"
+# 39132 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39218 "parsing/parser.ml"
+# 39140 "parsing/parser.ml"
in
-# 2683 "parsing/parser.mly"
+# 2685 "parsing/parser.mly"
( _1 )
-# 39224 "parsing/parser.ml"
+# 39146 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2691 "parsing/parser.mly"
+# 2693 "parsing/parser.mly"
( Ppat_interval (_1, _3) )
-# 39264 "parsing/parser.ml"
+# 39186 "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
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39273 "parsing/parser.ml"
+# 39195 "parsing/parser.ml"
in
-# 2683 "parsing/parser.mly"
+# 2685 "parsing/parser.mly"
( _1 )
-# 39279 "parsing/parser.ml"
+# 39201 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 39310 "parsing/parser.ml"
+# 39232 "parsing/parser.ml"
in
-# 2693 "parsing/parser.mly"
+# 2695 "parsing/parser.mly"
( Ppat_construct(_1, None) )
-# 39316 "parsing/parser.ml"
+# 39238 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39325 "parsing/parser.ml"
+# 39247 "parsing/parser.ml"
in
-# 2683 "parsing/parser.mly"
+# 2685 "parsing/parser.mly"
( _1 )
-# 39331 "parsing/parser.ml"
+# 39253 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2695 "parsing/parser.mly"
+# 2697 "parsing/parser.mly"
( Ppat_variant(_1, None) )
-# 39357 "parsing/parser.ml"
+# 39279 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39365 "parsing/parser.ml"
+# 39287 "parsing/parser.ml"
in
-# 2683 "parsing/parser.mly"
+# 2685 "parsing/parser.mly"
( _1 )
-# 39371 "parsing/parser.ml"
+# 39293 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 39410 "parsing/parser.ml"
+# 39332 "parsing/parser.ml"
in
-# 2697 "parsing/parser.mly"
+# 2699 "parsing/parser.mly"
( Ppat_type (_2) )
-# 39416 "parsing/parser.ml"
+# 39338 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39426 "parsing/parser.ml"
+# 39348 "parsing/parser.ml"
in
-# 2683 "parsing/parser.mly"
+# 2685 "parsing/parser.mly"
( _1 )
-# 39432 "parsing/parser.ml"
+# 39354 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 39477 "parsing/parser.ml"
+# 39399 "parsing/parser.ml"
in
-# 2699 "parsing/parser.mly"
+# 2701 "parsing/parser.mly"
( Ppat_open(_1, _3) )
-# 39483 "parsing/parser.ml"
+# 39405 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39493 "parsing/parser.ml"
+# 39415 "parsing/parser.ml"
in
-# 2683 "parsing/parser.mly"
+# 2685 "parsing/parser.mly"
( _1 )
-# 39499 "parsing/parser.ml"
+# 39421 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 =
let (_endpos__2_, _startpos__1_, _2, _1) = (_endpos__2_inlined1_, _startpos__1_inlined1_, _2_inlined1, _1_inlined1) in
let _1 =
-# 2700 "parsing/parser.mly"
+# 2702 "parsing/parser.mly"
(Lident "[]")
-# 39549 "parsing/parser.ml"
+# 39471 "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
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 39558 "parsing/parser.ml"
+# 39480 "parsing/parser.ml"
in
let _endpos__3_ = _endpos__2_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 39569 "parsing/parser.ml"
+# 39491 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2701 "parsing/parser.mly"
+# 2703 "parsing/parser.mly"
( Ppat_open(_1, mkpat ~loc:_sloc (Ppat_construct(_3, None))) )
-# 39578 "parsing/parser.ml"
+# 39500 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39588 "parsing/parser.ml"
+# 39510 "parsing/parser.ml"
in
-# 2683 "parsing/parser.mly"
+# 2685 "parsing/parser.mly"
( _1 )
-# 39594 "parsing/parser.ml"
+# 39516 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 =
let (_endpos__2_, _startpos__1_, _2, _1) = (_endpos__2_inlined1_, _startpos__1_inlined1_, _2_inlined1, _1_inlined1) in
let _1 =
-# 2702 "parsing/parser.mly"
+# 2704 "parsing/parser.mly"
(Lident "()")
-# 39644 "parsing/parser.ml"
+# 39566 "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
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 39653 "parsing/parser.ml"
+# 39575 "parsing/parser.ml"
in
let _endpos__3_ = _endpos__2_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 39664 "parsing/parser.ml"
+# 39586 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2703 "parsing/parser.mly"
+# 2705 "parsing/parser.mly"
( Ppat_open(_1, mkpat ~loc:_sloc (Ppat_construct(_3, None))) )
-# 39673 "parsing/parser.ml"
+# 39595 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39683 "parsing/parser.ml"
+# 39605 "parsing/parser.ml"
in
-# 2683 "parsing/parser.mly"
+# 2685 "parsing/parser.mly"
( _1 )
-# 39689 "parsing/parser.ml"
+# 39611 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 39748 "parsing/parser.ml"
+# 39670 "parsing/parser.ml"
in
-# 2705 "parsing/parser.mly"
+# 2707 "parsing/parser.mly"
( Ppat_open (_1, _4) )
-# 39754 "parsing/parser.ml"
+# 39676 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39764 "parsing/parser.ml"
+# 39686 "parsing/parser.ml"
in
-# 2683 "parsing/parser.mly"
+# 2685 "parsing/parser.mly"
( _1 )
-# 39770 "parsing/parser.ml"
+# 39692 "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
-# 2707 "parsing/parser.mly"
+# 2709 "parsing/parser.mly"
( unclosed "(" _loc__3_ ")" _loc__5_ )
-# 39827 "parsing/parser.ml"
+# 39749 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39837 "parsing/parser.ml"
+# 39759 "parsing/parser.ml"
in
-# 2683 "parsing/parser.mly"
+# 2685 "parsing/parser.mly"
( _1 )
-# 39843 "parsing/parser.ml"
+# 39765 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__4_ = (_startpos__4_, _endpos__4_) in
-# 2709 "parsing/parser.mly"
+# 2711 "parsing/parser.mly"
( expecting _loc__4_ "pattern" )
-# 39892 "parsing/parser.ml"
+# 39814 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39902 "parsing/parser.ml"
+# 39824 "parsing/parser.ml"
in
-# 2683 "parsing/parser.mly"
+# 2685 "parsing/parser.mly"
( _1 )
-# 39908 "parsing/parser.ml"
+# 39830 "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
-# 2711 "parsing/parser.mly"
+# 2713 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__3_ )
-# 39951 "parsing/parser.ml"
+# 39873 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39961 "parsing/parser.ml"
+# 39883 "parsing/parser.ml"
in
-# 2683 "parsing/parser.mly"
+# 2685 "parsing/parser.mly"
( _1 )
-# 39967 "parsing/parser.ml"
+# 39889 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__5_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2713 "parsing/parser.mly"
+# 2715 "parsing/parser.mly"
( Ppat_constraint(_2, _4) )
-# 40021 "parsing/parser.ml"
+# 39943 "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
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 40030 "parsing/parser.ml"
+# 39952 "parsing/parser.ml"
in
-# 2683 "parsing/parser.mly"
+# 2685 "parsing/parser.mly"
( _1 )
-# 40036 "parsing/parser.ml"
+# 39958 "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
-# 2715 "parsing/parser.mly"
+# 2717 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__5_ )
-# 40093 "parsing/parser.ml"
+# 40015 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 40103 "parsing/parser.ml"
+# 40025 "parsing/parser.ml"
in
-# 2683 "parsing/parser.mly"
+# 2685 "parsing/parser.mly"
( _1 )
-# 40109 "parsing/parser.ml"
+# 40031 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__4_ = (_startpos__4_, _endpos__4_) in
-# 2717 "parsing/parser.mly"
+# 2719 "parsing/parser.mly"
( expecting _loc__4_ "type" )
-# 40158 "parsing/parser.ml"
+# 40080 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 40168 "parsing/parser.ml"
+# 40090 "parsing/parser.ml"
in
-# 2683 "parsing/parser.mly"
+# 2685 "parsing/parser.mly"
( _1 )
-# 40174 "parsing/parser.ml"
+# 40096 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _6 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
- let _1 =
- let _1 =
-# 3320 "parsing/parser.mly"
- ( Ptyp_package (package_type_of_module_type _1) )
-# 40253 "parsing/parser.ml"
- in
- let _endpos = _endpos__1_ in
- let _symbolstartpos = _startpos__1_ in
- let _sloc = (_symbolstartpos, _endpos) in
-
-# 850 "parsing/parser.mly"
- ( mktyp ~loc:_sloc _1 )
-# 40261 "parsing/parser.ml"
-
- in
+ let _endpos = _endpos__1_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
-# 3321 "parsing/parser.mly"
- ( _1 )
-# 40267 "parsing/parser.ml"
+# 3335 "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 )
+# 40179 "parsing/parser.ml"
in
let _3 =
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 40277 "parsing/parser.ml"
+# 40189 "parsing/parser.ml"
in
-# 3742 "parsing/parser.mly"
+# 3758 "parsing/parser.mly"
( _1, _2 )
-# 40283 "parsing/parser.ml"
+# 40195 "parsing/parser.ml"
in
let _loc__7_ = (_startpos__7_, _endpos__7_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2720 "parsing/parser.mly"
+# 2722 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__7_ )
-# 40291 "parsing/parser.ml"
+# 40203 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 40301 "parsing/parser.ml"
+# 40213 "parsing/parser.ml"
in
-# 2683 "parsing/parser.mly"
+# 2685 "parsing/parser.mly"
( _1 )
-# 40307 "parsing/parser.ml"
+# 40219 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2722 "parsing/parser.mly"
+# 2724 "parsing/parser.mly"
( Ppat_extension _1 )
-# 40333 "parsing/parser.ml"
+# 40245 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 848 "parsing/parser.mly"
+# 852 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 40341 "parsing/parser.ml"
+# 40253 "parsing/parser.ml"
in
-# 2683 "parsing/parser.mly"
+# 2685 "parsing/parser.mly"
( _1 )
-# 40347 "parsing/parser.ml"
+# 40259 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 40368 "parsing/parser.ml"
+# 40280 "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) =
-# 3652 "parsing/parser.mly"
+# 3668 "parsing/parser.mly"
( _1 )
-# 40376 "parsing/parser.ml"
+# 40288 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 697 "parsing/parser.mly"
+# 701 "parsing/parser.mly"
(string)
-# 40397 "parsing/parser.ml"
+# 40309 "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) =
-# 3653 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( _1 )
-# 40405 "parsing/parser.ml"
+# 40317 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3654 "parsing/parser.mly"
+# 3670 "parsing/parser.mly"
( "and" )
-# 40430 "parsing/parser.ml"
+# 40342 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3655 "parsing/parser.mly"
+# 3671 "parsing/parser.mly"
( "as" )
-# 40455 "parsing/parser.ml"
+# 40367 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3656 "parsing/parser.mly"
+# 3672 "parsing/parser.mly"
( "assert" )
-# 40480 "parsing/parser.ml"
+# 40392 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3657 "parsing/parser.mly"
+# 3673 "parsing/parser.mly"
( "begin" )
-# 40505 "parsing/parser.ml"
+# 40417 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3658 "parsing/parser.mly"
+# 3674 "parsing/parser.mly"
( "class" )
-# 40530 "parsing/parser.ml"
+# 40442 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3659 "parsing/parser.mly"
+# 3675 "parsing/parser.mly"
( "constraint" )
-# 40555 "parsing/parser.ml"
+# 40467 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3660 "parsing/parser.mly"
+# 3676 "parsing/parser.mly"
( "do" )
-# 40580 "parsing/parser.ml"
+# 40492 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3661 "parsing/parser.mly"
+# 3677 "parsing/parser.mly"
( "done" )
-# 40605 "parsing/parser.ml"
+# 40517 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3662 "parsing/parser.mly"
+# 3678 "parsing/parser.mly"
( "downto" )
-# 40630 "parsing/parser.ml"
+# 40542 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3663 "parsing/parser.mly"
+# 3679 "parsing/parser.mly"
( "else" )
-# 40655 "parsing/parser.ml"
+# 40567 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3664 "parsing/parser.mly"
+# 3680 "parsing/parser.mly"
( "end" )
-# 40680 "parsing/parser.ml"
+# 40592 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3665 "parsing/parser.mly"
+# 3681 "parsing/parser.mly"
( "exception" )
-# 40705 "parsing/parser.ml"
+# 40617 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3666 "parsing/parser.mly"
+# 3682 "parsing/parser.mly"
( "external" )
-# 40730 "parsing/parser.ml"
+# 40642 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3667 "parsing/parser.mly"
+# 3683 "parsing/parser.mly"
( "false" )
-# 40755 "parsing/parser.ml"
+# 40667 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3668 "parsing/parser.mly"
+# 3684 "parsing/parser.mly"
( "for" )
-# 40780 "parsing/parser.ml"
+# 40692 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3669 "parsing/parser.mly"
+# 3685 "parsing/parser.mly"
( "fun" )
-# 40805 "parsing/parser.ml"
+# 40717 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3670 "parsing/parser.mly"
+# 3686 "parsing/parser.mly"
( "function" )
-# 40830 "parsing/parser.ml"
+# 40742 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3671 "parsing/parser.mly"
+# 3687 "parsing/parser.mly"
( "functor" )
-# 40855 "parsing/parser.ml"
+# 40767 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3672 "parsing/parser.mly"
+# 3688 "parsing/parser.mly"
( "if" )
-# 40880 "parsing/parser.ml"
+# 40792 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3673 "parsing/parser.mly"
+# 3689 "parsing/parser.mly"
( "in" )
-# 40905 "parsing/parser.ml"
+# 40817 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3674 "parsing/parser.mly"
+# 3690 "parsing/parser.mly"
( "include" )
-# 40930 "parsing/parser.ml"
+# 40842 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3675 "parsing/parser.mly"
+# 3691 "parsing/parser.mly"
( "inherit" )
-# 40955 "parsing/parser.ml"
+# 40867 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3676 "parsing/parser.mly"
+# 3692 "parsing/parser.mly"
( "initializer" )
-# 40980 "parsing/parser.ml"
+# 40892 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3677 "parsing/parser.mly"
+# 3693 "parsing/parser.mly"
( "lazy" )
-# 41005 "parsing/parser.ml"
+# 40917 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3678 "parsing/parser.mly"
+# 3694 "parsing/parser.mly"
( "let" )
-# 41030 "parsing/parser.ml"
+# 40942 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3679 "parsing/parser.mly"
+# 3695 "parsing/parser.mly"
( "match" )
-# 41055 "parsing/parser.ml"
+# 40967 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3680 "parsing/parser.mly"
+# 3696 "parsing/parser.mly"
( "method" )
-# 41080 "parsing/parser.ml"
+# 40992 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3681 "parsing/parser.mly"
+# 3697 "parsing/parser.mly"
( "module" )
-# 41105 "parsing/parser.ml"
+# 41017 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3682 "parsing/parser.mly"
+# 3698 "parsing/parser.mly"
( "mutable" )
-# 41130 "parsing/parser.ml"
+# 41042 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3683 "parsing/parser.mly"
+# 3699 "parsing/parser.mly"
( "new" )
-# 41155 "parsing/parser.ml"
+# 41067 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3684 "parsing/parser.mly"
+# 3700 "parsing/parser.mly"
( "nonrec" )
-# 41180 "parsing/parser.ml"
+# 41092 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3685 "parsing/parser.mly"
+# 3701 "parsing/parser.mly"
( "object" )
-# 41205 "parsing/parser.ml"
+# 41117 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3686 "parsing/parser.mly"
+# 3702 "parsing/parser.mly"
( "of" )
-# 41230 "parsing/parser.ml"
+# 41142 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3687 "parsing/parser.mly"
+# 3703 "parsing/parser.mly"
( "open" )
-# 41255 "parsing/parser.ml"
+# 41167 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3688 "parsing/parser.mly"
+# 3704 "parsing/parser.mly"
( "or" )
-# 41280 "parsing/parser.ml"
+# 41192 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3689 "parsing/parser.mly"
+# 3705 "parsing/parser.mly"
( "private" )
-# 41305 "parsing/parser.ml"
+# 41217 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3690 "parsing/parser.mly"
+# 3706 "parsing/parser.mly"
( "rec" )
-# 41330 "parsing/parser.ml"
+# 41242 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3691 "parsing/parser.mly"
+# 3707 "parsing/parser.mly"
( "sig" )
-# 41355 "parsing/parser.ml"
+# 41267 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3692 "parsing/parser.mly"
+# 3708 "parsing/parser.mly"
( "struct" )
-# 41380 "parsing/parser.ml"
+# 41292 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3693 "parsing/parser.mly"
+# 3709 "parsing/parser.mly"
( "then" )
-# 41405 "parsing/parser.ml"
+# 41317 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3694 "parsing/parser.mly"
+# 3710 "parsing/parser.mly"
( "to" )
-# 41430 "parsing/parser.ml"
+# 41342 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3695 "parsing/parser.mly"
+# 3711 "parsing/parser.mly"
( "true" )
-# 41455 "parsing/parser.ml"
+# 41367 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3696 "parsing/parser.mly"
+# 3712 "parsing/parser.mly"
( "try" )
-# 41480 "parsing/parser.ml"
+# 41392 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3697 "parsing/parser.mly"
+# 3713 "parsing/parser.mly"
( "type" )
-# 41505 "parsing/parser.ml"
+# 41417 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3698 "parsing/parser.mly"
+# 3714 "parsing/parser.mly"
( "val" )
-# 41530 "parsing/parser.ml"
+# 41442 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3699 "parsing/parser.mly"
+# 3715 "parsing/parser.mly"
( "virtual" )
-# 41555 "parsing/parser.ml"
+# 41467 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3700 "parsing/parser.mly"
+# 3716 "parsing/parser.mly"
( "when" )
-# 41580 "parsing/parser.ml"
+# 41492 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3701 "parsing/parser.mly"
+# 3717 "parsing/parser.mly"
( "while" )
-# 41605 "parsing/parser.ml"
+# 41517 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3702 "parsing/parser.mly"
+# 3718 "parsing/parser.mly"
( "with" )
-# 41630 "parsing/parser.ml"
+# 41542 "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) =
-# 2987 "parsing/parser.mly"
+# 3003 "parsing/parser.mly"
( _1 )
-# 41655 "parsing/parser.ml"
+# 41567 "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
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 41731 "parsing/parser.ml"
+# 41643 "parsing/parser.ml"
in
let _endpos_attrs_ = _endpos__1_inlined5_ in
let attrs2 =
let _1 = _1_inlined4 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 41740 "parsing/parser.ml"
+# 41652 "parsing/parser.ml"
in
let lid =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 41751 "parsing/parser.ml"
+# 41663 "parsing/parser.ml"
in
let id =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 41762 "parsing/parser.ml"
+# 41674 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 41770 "parsing/parser.ml"
+# 41682 "parsing/parser.ml"
in
let _endpos = _endpos_attrs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2996 "parsing/parser.mly"
+# 3012 "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 )
-# 41783 "parsing/parser.ml"
+# 41695 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) =
-# 2511 "parsing/parser.mly"
+# 2513 "parsing/parser.mly"
( _2 )
-# 41815 "parsing/parser.ml"
+# 41727 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2513 "parsing/parser.mly"
+# 2515 "parsing/parser.mly"
( let (l, o, p) = _1 in ghexp ~loc:_sloc (Pexp_fun(l, o, p, _2)) )
-# 41850 "parsing/parser.ml"
+# 41762 "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 =
-# 2414 "parsing/parser.mly"
+# 2416 "parsing/parser.mly"
( xs )
-# 41903 "parsing/parser.ml"
+# 41815 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2515 "parsing/parser.mly"
+# 2517 "parsing/parser.mly"
( mk_newtypes ~loc:_sloc _3 _5 )
-# 41911 "parsing/parser.ml"
+# 41823 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let ys =
# 260 "<standard.mly>"
( List.flatten xss )
-# 41938 "parsing/parser.ml"
+# 41850 "parsing/parser.ml"
in
let xs =
let items =
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( [] )
-# 41944 "parsing/parser.ml"
+# 41856 "parsing/parser.ml"
in
-# 1297 "parsing/parser.mly"
+# 1301 "parsing/parser.mly"
( items )
-# 41949 "parsing/parser.ml"
+# 41861 "parsing/parser.ml"
in
# 267 "<standard.mly>"
( xs @ ys )
-# 41955 "parsing/parser.ml"
+# 41867 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 805 "parsing/parser.mly"
+# 809 "parsing/parser.mly"
( extra_str _startpos _endpos _1 )
-# 41964 "parsing/parser.ml"
+# 41876 "parsing/parser.ml"
in
-# 1290 "parsing/parser.mly"
+# 1294 "parsing/parser.mly"
( _1 )
-# 41970 "parsing/parser.ml"
+# 41882 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let ys =
# 260 "<standard.mly>"
( List.flatten xss )
-# 42011 "parsing/parser.ml"
+# 41923 "parsing/parser.ml"
in
let xs =
let items =
let _1 =
let _1 =
let attrs =
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 42021 "parsing/parser.ml"
+# 41933 "parsing/parser.ml"
in
-# 1304 "parsing/parser.mly"
+# 1308 "parsing/parser.mly"
( mkstrexp e attrs )
-# 42026 "parsing/parser.ml"
+# 41938 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_e_ in
let _startpos = _startpos__1_ in
-# 817 "parsing/parser.mly"
+# 821 "parsing/parser.mly"
( text_str _startpos @ [_1] )
-# 42034 "parsing/parser.ml"
+# 41946 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_e_ in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 836 "parsing/parser.mly"
+# 840 "parsing/parser.mly"
( mark_rhs_docs _startpos _endpos;
_1 )
-# 42044 "parsing/parser.ml"
+# 41956 "parsing/parser.ml"
in
-# 885 "parsing/parser.mly"
+# 889 "parsing/parser.mly"
( x )
-# 42050 "parsing/parser.ml"
+# 41962 "parsing/parser.ml"
in
-# 1297 "parsing/parser.mly"
+# 1301 "parsing/parser.mly"
( items )
-# 42056 "parsing/parser.ml"
+# 41968 "parsing/parser.ml"
in
# 267 "<standard.mly>"
( xs @ ys )
-# 42062 "parsing/parser.ml"
+# 41974 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_e_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 805 "parsing/parser.mly"
+# 809 "parsing/parser.mly"
( extra_str _startpos _endpos _1 )
-# 42071 "parsing/parser.ml"
+# 41983 "parsing/parser.ml"
in
-# 1290 "parsing/parser.mly"
+# 1294 "parsing/parser.mly"
( _1 )
-# 42077 "parsing/parser.ml"
+# 41989 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1319 "parsing/parser.mly"
+# 1323 "parsing/parser.mly"
( val_of_let_bindings ~loc:_sloc _1 )
-# 42105 "parsing/parser.ml"
+# 42017 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 42141 "parsing/parser.ml"
+# 42053 "parsing/parser.ml"
in
let _endpos__2_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1322 "parsing/parser.mly"
+# 1326 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
Pstr_extension (_1, add_docs_attrs docs _2) )
-# 42152 "parsing/parser.ml"
+# 42064 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 856 "parsing/parser.mly"
( mkstr ~loc:_sloc _1 )
-# 42162 "parsing/parser.ml"
+# 42074 "parsing/parser.ml"
in
-# 1353 "parsing/parser.mly"
+# 1357 "parsing/parser.mly"
( _1 )
-# 42168 "parsing/parser.ml"
+# 42080 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1325 "parsing/parser.mly"
+# 1329 "parsing/parser.mly"
( Pstr_attribute _1 )
-# 42194 "parsing/parser.ml"
+# 42106 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 856 "parsing/parser.mly"
( mkstr ~loc:_sloc _1 )
-# 42202 "parsing/parser.ml"
+# 42114 "parsing/parser.ml"
in
-# 1353 "parsing/parser.mly"
+# 1357 "parsing/parser.mly"
( _1 )
-# 42208 "parsing/parser.ml"
+# 42120 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1329 "parsing/parser.mly"
+# 1333 "parsing/parser.mly"
( pstr_primitive _1 )
-# 42234 "parsing/parser.ml"
+# 42146 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 869 "parsing/parser.mly"
+# 873 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 42242 "parsing/parser.ml"
+# 42154 "parsing/parser.ml"
in
-# 1353 "parsing/parser.mly"
+# 1357 "parsing/parser.mly"
( _1 )
-# 42248 "parsing/parser.ml"
+# 42160 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1331 "parsing/parser.mly"
+# 1335 "parsing/parser.mly"
( pstr_primitive _1 )
-# 42274 "parsing/parser.ml"
+# 42186 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 869 "parsing/parser.mly"
+# 873 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 42282 "parsing/parser.ml"
+# 42194 "parsing/parser.ml"
in
-# 1353 "parsing/parser.mly"
+# 1357 "parsing/parser.mly"
( _1 )
-# 42288 "parsing/parser.ml"
+# 42200 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _1 =
let _1 =
-# 1044 "parsing/parser.mly"
+# 1048 "parsing/parser.mly"
( let (x, b) = a in x, b :: bs )
-# 42325 "parsing/parser.ml"
+# 42237 "parsing/parser.ml"
in
-# 2842 "parsing/parser.mly"
+# 2847 "parsing/parser.mly"
( _1 )
-# 42330 "parsing/parser.ml"
+# 42242 "parsing/parser.ml"
in
-# 2825 "parsing/parser.mly"
+# 2830 "parsing/parser.mly"
( _1 )
-# 42336 "parsing/parser.ml"
+# 42248 "parsing/parser.ml"
in
-# 1333 "parsing/parser.mly"
+# 1337 "parsing/parser.mly"
( pstr_type _1 )
-# 42342 "parsing/parser.ml"
+# 42254 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_bs_, _startpos_a_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 869 "parsing/parser.mly"
+# 873 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 42352 "parsing/parser.ml"
+# 42264 "parsing/parser.ml"
in
-# 1353 "parsing/parser.mly"
+# 1357 "parsing/parser.mly"
( _1 )
-# 42358 "parsing/parser.ml"
+# 42270 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let priv : (Asttypes.private_flag) = Obj.magic priv in
let _7 : unit = Obj.magic _7 in
let _1_inlined2 : (Longident.t) = Obj.magic _1_inlined2 in
- let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params 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 ext : (string Asttypes.loc option) = Obj.magic ext in
let _1 : unit = Obj.magic _1 in
let attrs2 =
let _1 = _1_inlined3 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 42445 "parsing/parser.ml"
+# 42357 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let cs =
-# 1036 "parsing/parser.mly"
+# 1040 "parsing/parser.mly"
( List.rev xs )
-# 42452 "parsing/parser.ml"
+# 42364 "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
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 42462 "parsing/parser.ml"
+# 42374 "parsing/parser.ml"
in
let _4 =
-# 3574 "parsing/parser.mly"
+# 3590 "parsing/parser.mly"
( Recursive )
-# 42468 "parsing/parser.ml"
+# 42380 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 42475 "parsing/parser.ml"
+# 42387 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3079 "parsing/parser.mly"
+# 3095 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
let attrs = attrs1 @ attrs2 in
Te.mk tid cs ~params ~priv ~attrs ~docs,
ext )
-# 42487 "parsing/parser.ml"
+# 42399 "parsing/parser.ml"
in
-# 3062 "parsing/parser.mly"
+# 3078 "parsing/parser.mly"
( _1 )
-# 42493 "parsing/parser.ml"
+# 42405 "parsing/parser.ml"
in
-# 1335 "parsing/parser.mly"
+# 1339 "parsing/parser.mly"
( pstr_typext _1 )
-# 42499 "parsing/parser.ml"
+# 42411 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 869 "parsing/parser.mly"
+# 873 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 42509 "parsing/parser.ml"
+# 42421 "parsing/parser.ml"
in
-# 1353 "parsing/parser.mly"
+# 1357 "parsing/parser.mly"
( _1 )
-# 42515 "parsing/parser.ml"
+# 42427 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let priv : (Asttypes.private_flag) = Obj.magic priv in
let _7 : unit = Obj.magic _7 in
let _1_inlined3 : (Longident.t) = Obj.magic _1_inlined3 in
- let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in
+ let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let _1_inlined2 : unit = 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 attrs2 =
let _1 = _1_inlined4 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 42609 "parsing/parser.ml"
+# 42521 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let cs =
-# 1036 "parsing/parser.mly"
+# 1040 "parsing/parser.mly"
( List.rev xs )
-# 42616 "parsing/parser.ml"
+# 42528 "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
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 42626 "parsing/parser.ml"
+# 42538 "parsing/parser.ml"
in
let _4 =
let _startpos = _startpos__1_ in
let _loc = (_startpos, _endpos) in
-# 3575 "parsing/parser.mly"
+# 3591 "parsing/parser.mly"
( not_expecting _loc "nonrec flag" )
-# 42637 "parsing/parser.ml"
+# 42549 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 42645 "parsing/parser.ml"
+# 42557 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3079 "parsing/parser.mly"
+# 3095 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
let attrs = attrs1 @ attrs2 in
Te.mk tid cs ~params ~priv ~attrs ~docs,
ext )
-# 42657 "parsing/parser.ml"
+# 42569 "parsing/parser.ml"
in
-# 3062 "parsing/parser.mly"
+# 3078 "parsing/parser.mly"
( _1 )
-# 42663 "parsing/parser.ml"
+# 42575 "parsing/parser.ml"
in
-# 1335 "parsing/parser.mly"
+# 1339 "parsing/parser.mly"
( pstr_typext _1 )
-# 42669 "parsing/parser.ml"
+# 42581 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 869 "parsing/parser.mly"
+# 873 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 42679 "parsing/parser.ml"
+# 42591 "parsing/parser.ml"
in
-# 1353 "parsing/parser.mly"
+# 1357 "parsing/parser.mly"
( _1 )
-# 42685 "parsing/parser.ml"
+# 42597 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1337 "parsing/parser.mly"
+# 1341 "parsing/parser.mly"
( pstr_exception _1 )
-# 42711 "parsing/parser.ml"
+# 42623 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 869 "parsing/parser.mly"
+# 873 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 42719 "parsing/parser.ml"
+# 42631 "parsing/parser.ml"
in
-# 1353 "parsing/parser.mly"
+# 1357 "parsing/parser.mly"
( _1 )
-# 42725 "parsing/parser.ml"
+# 42637 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined3 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 42790 "parsing/parser.ml"
+# 42702 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 42802 "parsing/parser.ml"
+# 42714 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 42810 "parsing/parser.ml"
+# 42722 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1363 "parsing/parser.mly"
+# 1367 "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 )
-# 42823 "parsing/parser.ml"
+# 42735 "parsing/parser.ml"
in
-# 1339 "parsing/parser.mly"
+# 1343 "parsing/parser.mly"
( _1 )
-# 42829 "parsing/parser.ml"
+# 42741 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 869 "parsing/parser.mly"
+# 873 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 42839 "parsing/parser.ml"
+# 42751 "parsing/parser.ml"
in
-# 1353 "parsing/parser.mly"
+# 1357 "parsing/parser.mly"
( _1 )
-# 42845 "parsing/parser.ml"
+# 42757 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined3 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 42926 "parsing/parser.ml"
+# 42838 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 42938 "parsing/parser.ml"
+# 42850 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 42946 "parsing/parser.ml"
+# 42858 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1397 "parsing/parser.mly"
+# 1402 "parsing/parser.mly"
(
let loc = make_loc _sloc in
let attrs = attrs1 @ attrs2 in
ext,
Mb.mk name body ~attrs ~loc ~docs
)
-# 42961 "parsing/parser.ml"
+# 42873 "parsing/parser.ml"
in
-# 1044 "parsing/parser.mly"
+# 1048 "parsing/parser.mly"
( let (x, b) = a in x, b :: bs )
-# 42967 "parsing/parser.ml"
+# 42879 "parsing/parser.ml"
in
-# 1385 "parsing/parser.mly"
+# 1390 "parsing/parser.mly"
( _1 )
-# 42973 "parsing/parser.ml"
+# 42885 "parsing/parser.ml"
in
-# 1341 "parsing/parser.mly"
+# 1345 "parsing/parser.mly"
( pstr_recmodule _1 )
-# 42979 "parsing/parser.ml"
+# 42891 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_bs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 869 "parsing/parser.mly"
+# 873 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 42989 "parsing/parser.ml"
+# 42901 "parsing/parser.ml"
in
-# 1353 "parsing/parser.mly"
+# 1357 "parsing/parser.mly"
( _1 )
-# 42995 "parsing/parser.ml"
+# 42907 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1343 "parsing/parser.mly"
+# 1347 "parsing/parser.mly"
( let (body, ext) = _1 in (Pstr_modtype body, ext) )
-# 43021 "parsing/parser.ml"
+# 42933 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 869 "parsing/parser.mly"
+# 873 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 43029 "parsing/parser.ml"
+# 42941 "parsing/parser.ml"
in
-# 1353 "parsing/parser.mly"
+# 1357 "parsing/parser.mly"
( _1 )
-# 43035 "parsing/parser.ml"
+# 42947 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1345 "parsing/parser.mly"
+# 1349 "parsing/parser.mly"
( let (body, ext) = _1 in (Pstr_open body, ext) )
-# 43061 "parsing/parser.ml"
+# 42973 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 869 "parsing/parser.mly"
+# 873 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 43069 "parsing/parser.ml"
+# 42981 "parsing/parser.ml"
in
-# 1353 "parsing/parser.mly"
+# 1357 "parsing/parser.mly"
( _1 )
-# 43075 "parsing/parser.ml"
+# 42987 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
let body : (Parsetree.class_expr) = Obj.magic body in
let _1_inlined2 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 43147 "parsing/parser.ml"
+# 43059 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
- let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params 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 _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let ext : (string Asttypes.loc option) = Obj.magic ext in
let attrs2 =
let _1 = _1_inlined3 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 43167 "parsing/parser.ml"
+# 43079 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 43179 "parsing/parser.ml"
+# 43091 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 43187 "parsing/parser.ml"
+# 43099 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1715 "parsing/parser.mly"
+# 1721 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
ext,
Ci.mk id body ~virt ~params ~attrs ~loc ~docs
)
-# 43202 "parsing/parser.ml"
+# 43114 "parsing/parser.ml"
in
-# 1044 "parsing/parser.mly"
+# 1048 "parsing/parser.mly"
( let (x, b) = a in x, b :: bs )
-# 43208 "parsing/parser.ml"
+# 43120 "parsing/parser.ml"
in
-# 1704 "parsing/parser.mly"
+# 1710 "parsing/parser.mly"
( _1 )
-# 43214 "parsing/parser.ml"
+# 43126 "parsing/parser.ml"
in
-# 1347 "parsing/parser.mly"
+# 1351 "parsing/parser.mly"
( let (ext, l) = _1 in (Pstr_class l, ext) )
-# 43220 "parsing/parser.ml"
+# 43132 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_bs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 869 "parsing/parser.mly"
+# 873 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 43230 "parsing/parser.ml"
+# 43142 "parsing/parser.ml"
in
-# 1353 "parsing/parser.mly"
+# 1357 "parsing/parser.mly"
( _1 )
-# 43236 "parsing/parser.ml"
+# 43148 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1349 "parsing/parser.mly"
+# 1353 "parsing/parser.mly"
( let (ext, l) = _1 in (Pstr_class_type l, ext) )
-# 43262 "parsing/parser.ml"
+# 43174 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 869 "parsing/parser.mly"
+# 873 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 43270 "parsing/parser.ml"
+# 43182 "parsing/parser.ml"
in
-# 1353 "parsing/parser.mly"
+# 1357 "parsing/parser.mly"
( _1 )
-# 43276 "parsing/parser.ml"
+# 43188 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined2 in
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 43334 "parsing/parser.ml"
+# 43246 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined2_ in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 43343 "parsing/parser.ml"
+# 43255 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1434 "parsing/parser.mly"
+# 1439 "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
)
-# 43357 "parsing/parser.ml"
+# 43269 "parsing/parser.ml"
in
-# 1351 "parsing/parser.mly"
+# 1355 "parsing/parser.mly"
( pstr_include _1 )
-# 43363 "parsing/parser.ml"
+# 43275 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 869 "parsing/parser.mly"
+# 873 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 43373 "parsing/parser.ml"
+# 43285 "parsing/parser.ml"
in
-# 1353 "parsing/parser.mly"
+# 1357 "parsing/parser.mly"
( _1 )
-# 43379 "parsing/parser.ml"
+# 43291 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3637 "parsing/parser.mly"
+# 3653 "parsing/parser.mly"
( "-" )
-# 43404 "parsing/parser.ml"
+# 43316 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3638 "parsing/parser.mly"
+# 3654 "parsing/parser.mly"
( "-." )
-# 43429 "parsing/parser.ml"
+# 43341 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.row_field) = let _5 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 43484 "parsing/parser.ml"
+# 43396 "parsing/parser.ml"
in
let _endpos__5_ = _endpos__1_inlined1_ in
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 43493 "parsing/parser.ml"
+# 43405 "parsing/parser.ml"
in
-# 947 "parsing/parser.mly"
+# 951 "parsing/parser.mly"
( xs )
-# 43498 "parsing/parser.ml"
+# 43410 "parsing/parser.ml"
in
-# 3349 "parsing/parser.mly"
+# 3365 "parsing/parser.mly"
( _1 )
-# 43504 "parsing/parser.ml"
+# 43416 "parsing/parser.ml"
in
let _1 =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 43514 "parsing/parser.ml"
+# 43426 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3335 "parsing/parser.mly"
+# 3351 "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 )
-# 43525 "parsing/parser.ml"
+# 43437 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.row_field) = let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 43559 "parsing/parser.ml"
+# 43471 "parsing/parser.ml"
in
let _endpos__2_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 43570 "parsing/parser.ml"
+# 43482 "parsing/parser.ml"
in
let _endpos = _endpos__2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3339 "parsing/parser.mly"
+# 3355 "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 [] )
-# 43581 "parsing/parser.ml"
+# 43493 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.toplevel_phrase) = let arg =
# 124 "<standard.mly>"
( None )
-# 43613 "parsing/parser.ml"
+# 43525 "parsing/parser.ml"
in
let _endpos_arg_ = _endpos__1_inlined1_ in
let dir =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 43624 "parsing/parser.ml"
+# 43536 "parsing/parser.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3537 "parsing/parser.mly"
+# 3553 "parsing/parser.mly"
( mk_directive ~loc:_sloc dir arg )
-# 43633 "parsing/parser.ml"
+# 43545 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _1_inlined2 : (
-# 685 "parsing/parser.mly"
+# 689 "parsing/parser.mly"
(string * Location.t * string option)
-# 43666 "parsing/parser.ml"
+# 43578 "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 =
-# 3541 "parsing/parser.mly"
+# 3557 "parsing/parser.mly"
( let (s, _, _) = _1 in Pdir_string s )
-# 43679 "parsing/parser.ml"
+# 43591 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 874 "parsing/parser.mly"
+# 878 "parsing/parser.mly"
( mk_directive_arg ~loc:_sloc _1 )
-# 43687 "parsing/parser.ml"
+# 43599 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 43693 "parsing/parser.ml"
+# 43605 "parsing/parser.ml"
in
let _endpos_arg_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 43705 "parsing/parser.ml"
+# 43617 "parsing/parser.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3537 "parsing/parser.mly"
+# 3553 "parsing/parser.mly"
( mk_directive ~loc:_sloc dir arg )
-# 43714 "parsing/parser.ml"
+# 43626 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _1_inlined2 : (
-# 633 "parsing/parser.mly"
+# 637 "parsing/parser.mly"
(string * char option)
-# 43747 "parsing/parser.ml"
+# 43659 "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 =
-# 3542 "parsing/parser.mly"
+# 3558 "parsing/parser.mly"
( let (n, m) = _1 in Pdir_int (n ,m) )
-# 43760 "parsing/parser.ml"
+# 43672 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 874 "parsing/parser.mly"
+# 878 "parsing/parser.mly"
( mk_directive_arg ~loc:_sloc _1 )
-# 43768 "parsing/parser.ml"
+# 43680 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 43774 "parsing/parser.ml"
+# 43686 "parsing/parser.ml"
in
let _endpos_arg_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 43786 "parsing/parser.ml"
+# 43698 "parsing/parser.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3537 "parsing/parser.mly"
+# 3553 "parsing/parser.mly"
( mk_directive ~loc:_sloc dir arg )
-# 43795 "parsing/parser.ml"
+# 43707 "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 =
-# 3543 "parsing/parser.mly"
+# 3559 "parsing/parser.mly"
( Pdir_ident _1 )
-# 43837 "parsing/parser.ml"
+# 43749 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 874 "parsing/parser.mly"
+# 878 "parsing/parser.mly"
( mk_directive_arg ~loc:_sloc _1 )
-# 43845 "parsing/parser.ml"
+# 43757 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 43851 "parsing/parser.ml"
+# 43763 "parsing/parser.ml"
in
let _endpos_arg_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 43863 "parsing/parser.ml"
+# 43775 "parsing/parser.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3537 "parsing/parser.mly"
+# 3553 "parsing/parser.mly"
( mk_directive ~loc:_sloc dir arg )
-# 43872 "parsing/parser.ml"
+# 43784 "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 =
-# 3544 "parsing/parser.mly"
+# 3560 "parsing/parser.mly"
( Pdir_ident _1 )
-# 43914 "parsing/parser.ml"
+# 43826 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 874 "parsing/parser.mly"
+# 878 "parsing/parser.mly"
( mk_directive_arg ~loc:_sloc _1 )
-# 43922 "parsing/parser.ml"
+# 43834 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 43928 "parsing/parser.ml"
+# 43840 "parsing/parser.ml"
in
let _endpos_arg_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 43940 "parsing/parser.ml"
+# 43852 "parsing/parser.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3537 "parsing/parser.mly"
+# 3553 "parsing/parser.mly"
( mk_directive ~loc:_sloc dir arg )
-# 43949 "parsing/parser.ml"
+# 43861 "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 =
-# 3545 "parsing/parser.mly"
+# 3561 "parsing/parser.mly"
( Pdir_bool false )
-# 43991 "parsing/parser.ml"
+# 43903 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 874 "parsing/parser.mly"
+# 878 "parsing/parser.mly"
( mk_directive_arg ~loc:_sloc _1 )
-# 43999 "parsing/parser.ml"
+# 43911 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 44005 "parsing/parser.ml"
+# 43917 "parsing/parser.ml"
in
let _endpos_arg_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 44017 "parsing/parser.ml"
+# 43929 "parsing/parser.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3537 "parsing/parser.mly"
+# 3553 "parsing/parser.mly"
( mk_directive ~loc:_sloc dir arg )
-# 44026 "parsing/parser.ml"
+# 43938 "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 =
-# 3546 "parsing/parser.mly"
+# 3562 "parsing/parser.mly"
( Pdir_bool true )
-# 44068 "parsing/parser.ml"
+# 43980 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 874 "parsing/parser.mly"
+# 878 "parsing/parser.mly"
( mk_directive_arg ~loc:_sloc _1 )
-# 44076 "parsing/parser.ml"
+# 43988 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 44082 "parsing/parser.ml"
+# 43994 "parsing/parser.ml"
in
let _endpos_arg_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 44094 "parsing/parser.ml"
+# 44006 "parsing/parser.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3537 "parsing/parser.mly"
+# 3553 "parsing/parser.mly"
( mk_directive ~loc:_sloc dir arg )
-# 44103 "parsing/parser.ml"
+# 44015 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_e_ in
let _endpos = _endpos__2_ in
let _v : (
-# 781 "parsing/parser.mly"
+# 785 "parsing/parser.mly"
(Parsetree.toplevel_phrase)
-# 44142 "parsing/parser.ml"
+# 44054 "parsing/parser.ml"
) = let _1 =
let _1 =
let _1 =
let attrs =
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 44149 "parsing/parser.ml"
+# 44061 "parsing/parser.ml"
in
-# 1304 "parsing/parser.mly"
+# 1308 "parsing/parser.mly"
( mkstrexp e attrs )
-# 44154 "parsing/parser.ml"
+# 44066 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_e_ in
let _startpos = _startpos__1_ in
-# 817 "parsing/parser.mly"
+# 821 "parsing/parser.mly"
( text_str _startpos @ [_1] )
-# 44162 "parsing/parser.ml"
+# 44074 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_e_ in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 805 "parsing/parser.mly"
+# 809 "parsing/parser.mly"
( extra_str _startpos _endpos _1 )
-# 44171 "parsing/parser.ml"
+# 44083 "parsing/parser.ml"
in
-# 1082 "parsing/parser.mly"
+# 1086 "parsing/parser.mly"
( Ptop_def _1 )
-# 44177 "parsing/parser.ml"
+# 44089 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xss_ in
let _endpos = _endpos__2_ in
let _v : (
-# 781 "parsing/parser.mly"
+# 785 "parsing/parser.mly"
(Parsetree.toplevel_phrase)
-# 44209 "parsing/parser.ml"
+# 44121 "parsing/parser.ml"
) = let _1 =
let _1 =
# 260 "<standard.mly>"
( List.flatten xss )
-# 44214 "parsing/parser.ml"
+# 44126 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 805 "parsing/parser.mly"
+# 809 "parsing/parser.mly"
( extra_str _startpos _endpos _1 )
-# 44222 "parsing/parser.ml"
+# 44134 "parsing/parser.ml"
in
-# 1086 "parsing/parser.mly"
+# 1090 "parsing/parser.mly"
( Ptop_def _1 )
-# 44228 "parsing/parser.ml"
+# 44140 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (
-# 781 "parsing/parser.mly"
+# 785 "parsing/parser.mly"
(Parsetree.toplevel_phrase)
-# 44260 "parsing/parser.ml"
+# 44172 "parsing/parser.ml"
) =
-# 1090 "parsing/parser.mly"
+# 1094 "parsing/parser.mly"
( _1 )
-# 44264 "parsing/parser.ml"
+# 44176 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (
-# 781 "parsing/parser.mly"
+# 785 "parsing/parser.mly"
(Parsetree.toplevel_phrase)
-# 44289 "parsing/parser.ml"
+# 44201 "parsing/parser.ml"
) =
-# 1093 "parsing/parser.mly"
+# 1097 "parsing/parser.mly"
( raise End_of_file )
-# 44293 "parsing/parser.ml"
+# 44205 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_ty_ in
let _endpos = _endpos_ty_ in
let _v : (Parsetree.core_type) =
-# 3241 "parsing/parser.mly"
+# 3257 "parsing/parser.mly"
( ty )
-# 44318 "parsing/parser.ml"
+# 44230 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 44346 "parsing/parser.ml"
+# 44258 "parsing/parser.ml"
in
-# 975 "parsing/parser.mly"
+# 979 "parsing/parser.mly"
( xs )
-# 44351 "parsing/parser.ml"
+# 44263 "parsing/parser.ml"
in
-# 3244 "parsing/parser.mly"
+# 3260 "parsing/parser.mly"
( Ptyp_tuple tys )
-# 44357 "parsing/parser.ml"
+# 44269 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_xs_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 854 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 44367 "parsing/parser.ml"
+# 44279 "parsing/parser.ml"
in
-# 3246 "parsing/parser.mly"
+# 3262 "parsing/parser.mly"
( _1 )
-# 44373 "parsing/parser.ml"
+# 44285 "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) =
-# 2589 "parsing/parser.mly"
+# 2591 "parsing/parser.mly"
( (Some _2, None) )
-# 44405 "parsing/parser.ml"
+# 44317 "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) =
-# 2590 "parsing/parser.mly"
+# 2592 "parsing/parser.mly"
( (Some _2, Some _4) )
-# 44451 "parsing/parser.ml"
+# 44363 "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) =
-# 2591 "parsing/parser.mly"
+# 2593 "parsing/parser.mly"
( (None, Some _2) )
-# 44483 "parsing/parser.ml"
+# 44395 "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) =
-# 2592 "parsing/parser.mly"
+# 2594 "parsing/parser.mly"
( syntax_error() )
-# 44515 "parsing/parser.ml"
+# 44427 "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) =
-# 2593 "parsing/parser.mly"
+# 2595 "parsing/parser.mly"
( syntax_error() )
-# 44547 "parsing/parser.ml"
+# 44459 "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) =
-# 2916 "parsing/parser.mly"
+# 2921 "parsing/parser.mly"
( (Ptype_abstract, Public, None) )
-# 44565 "parsing/parser.ml"
+# 44477 "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) =
-# 2918 "parsing/parser.mly"
+# 2923 "parsing/parser.mly"
( _2 )
-# 44597 "parsing/parser.ml"
+# 44509 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3500 "parsing/parser.mly"
+# 3516 "parsing/parser.mly"
( _1 )
-# 44622 "parsing/parser.ml"
+# 44534 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _2 : (Parsetree.core_type) = Obj.magic _2 in
- let _1 : (Asttypes.variance) = Obj.magic _1 in
+ let _1 : (Asttypes.variance * Asttypes.injectivity) = 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.core_type * Asttypes.variance) =
-# 2933 "parsing/parser.mly"
+ let _v : (Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) =
+# 2938 "parsing/parser.mly"
( _2, _1 )
-# 44654 "parsing/parser.ml"
+# 44566 "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.core_type * Asttypes.variance) list) =
-# 2926 "parsing/parser.mly"
+ let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) =
+# 2931 "parsing/parser.mly"
( [] )
-# 44672 "parsing/parser.ml"
+# 44584 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos_p_;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
- let p : (Parsetree.core_type * Asttypes.variance) = Obj.magic p in
+ let p : (Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) = Obj.magic p in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_p_ in
let _endpos = _endpos_p_ in
- let _v : ((Parsetree.core_type * Asttypes.variance) list) =
-# 2928 "parsing/parser.mly"
+ let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) =
+# 2933 "parsing/parser.mly"
( [p] )
-# 44697 "parsing/parser.ml"
+# 44609 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _3 : unit = Obj.magic _3 in
- let xs : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic xs in
+ let xs : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) 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__3_ in
- let _v : ((Parsetree.core_type * Asttypes.variance) list) = let ps =
+ let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = let ps =
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 44737 "parsing/parser.ml"
+# 44649 "parsing/parser.ml"
in
-# 947 "parsing/parser.mly"
+# 951 "parsing/parser.mly"
( xs )
-# 44742 "parsing/parser.ml"
+# 44654 "parsing/parser.ml"
in
-# 2930 "parsing/parser.mly"
+# 2935 "parsing/parser.mly"
( ps )
-# 44748 "parsing/parser.ml"
+# 44660 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_tyvar_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 2938 "parsing/parser.mly"
+# 2943 "parsing/parser.mly"
( Ptyp_var tyvar )
-# 44781 "parsing/parser.ml"
+# 44693 "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
-# 850 "parsing/parser.mly"
+# 854 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 44790 "parsing/parser.ml"
+# 44702 "parsing/parser.ml"
in
-# 2941 "parsing/parser.mly"
+# 2946 "parsing/parser.mly"
( _1 )
-# 44796 "parsing/parser.ml"
+# 44708 "parsing/parser.ml"
+ in
+ {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = Obj.repr _v;
+ MenhirLib.EngineTypes.startp = _startpos;
+ MenhirLib.EngineTypes.endp = _endpos;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ });
+ (fun _menhir_env ->
+ let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+ let {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ } = _menhir_stack in
+ let _1 : unit = Obj.magic _1 in
+ let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+ let _startpos = _startpos__1_ in
+ let _endpos = _endpos__1_ in
+ let _v : (Parsetree.core_type) = let _1 =
+ let _1 =
+# 2945 "parsing/parser.mly"
+ ( Ptyp_any )
+# 44734 "parsing/parser.ml"
+ in
+ let _endpos = _endpos__1_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
+
+# 854 "parsing/parser.mly"
+ ( mktyp ~loc:_sloc _1 )
+# 44742 "parsing/parser.ml"
+
+ in
+
+# 2946 "parsing/parser.mly"
+ ( _1 )
+# 44748 "parsing/parser.ml"
+ in
+ {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = Obj.repr _v;
+ MenhirLib.EngineTypes.startp = _startpos;
+ MenhirLib.EngineTypes.endp = _endpos;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ });
+ (fun _menhir_env ->
+ let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+ let _menhir_s = _menhir_env.MenhirLib.EngineTypes.current in
+ let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+ let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
+ let _endpos = _startpos in
+ let _v : (Asttypes.variance * Asttypes.injectivity) =
+# 2950 "parsing/parser.mly"
+ ( NoVariance, NoInjectivity )
+# 44766 "parsing/parser.ml"
+ in
+ {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = Obj.repr _v;
+ MenhirLib.EngineTypes.startp = _startpos;
+ MenhirLib.EngineTypes.endp = _endpos;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ });
+ (fun _menhir_env ->
+ let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+ let {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ } = _menhir_stack in
+ let _1 : unit = Obj.magic _1 in
+ let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+ let _startpos = _startpos__1_ in
+ let _endpos = _endpos__1_ in
+ let _v : (Asttypes.variance * Asttypes.injectivity) =
+# 2951 "parsing/parser.mly"
+ ( Covariant, NoInjectivity )
+# 44791 "parsing/parser.ml"
+ in
+ {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = Obj.repr _v;
+ MenhirLib.EngineTypes.startp = _startpos;
+ MenhirLib.EngineTypes.endp = _endpos;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ });
+ (fun _menhir_env ->
+ let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+ let {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ } = _menhir_stack in
+ let _1 : unit = Obj.magic _1 in
+ let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+ let _startpos = _startpos__1_ in
+ let _endpos = _endpos__1_ in
+ let _v : (Asttypes.variance * Asttypes.injectivity) =
+# 2952 "parsing/parser.mly"
+ ( Contravariant, NoInjectivity )
+# 44816 "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__1_ in
- let _v : (Parsetree.core_type) = let _1 =
- let _1 =
-# 2940 "parsing/parser.mly"
- ( Ptyp_any )
-# 44822 "parsing/parser.ml"
- in
- let _endpos = _endpos__1_ in
- let _symbolstartpos = _startpos__1_ in
- let _sloc = (_symbolstartpos, _endpos) in
-
-# 850 "parsing/parser.mly"
- ( mktyp ~loc:_sloc _1 )
-# 44830 "parsing/parser.ml"
-
- in
-
-# 2941 "parsing/parser.mly"
- ( _1 )
-# 44836 "parsing/parser.ml"
+ let _v : (Asttypes.variance * Asttypes.injectivity) =
+# 2953 "parsing/parser.mly"
+ ( NoVariance, Injective )
+# 44841 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
});
(fun _menhir_env ->
let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
- let _menhir_s = _menhir_env.MenhirLib.EngineTypes.current in
+ let {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _2;
+ MenhirLib.EngineTypes.startp = _startpos__2_;
+ MenhirLib.EngineTypes.endp = _endpos__2_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ };
+ } = _menhir_stack in
+ let _2 : unit = Obj.magic _2 in
+ let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
- let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
- let _endpos = _startpos in
- let _v : (Asttypes.variance) =
-# 2945 "parsing/parser.mly"
- ( Invariant )
-# 44854 "parsing/parser.ml"
+ let _startpos = _startpos__1_ in
+ let _endpos = _endpos__2_ in
+ let _v : (Asttypes.variance * Asttypes.injectivity) =
+# 2954 "parsing/parser.mly"
+ ( Covariant, Injective )
+# 44873 "parsing/parser.ml"
+ in
+ {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = Obj.repr _v;
+ MenhirLib.EngineTypes.startp = _startpos;
+ MenhirLib.EngineTypes.endp = _endpos;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ });
+ (fun _menhir_env ->
+ let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+ let {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _2;
+ MenhirLib.EngineTypes.startp = _startpos__2_;
+ MenhirLib.EngineTypes.endp = _endpos__2_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ };
+ } = _menhir_stack in
+ let _2 : unit = Obj.magic _2 in
+ let _1 : unit = Obj.magic _1 in
+ let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+ let _startpos = _startpos__1_ in
+ let _endpos = _endpos__2_ in
+ let _v : (Asttypes.variance * Asttypes.injectivity) =
+# 2954 "parsing/parser.mly"
+ ( Covariant, Injective )
+# 44905 "parsing/parser.ml"
+ in
+ {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = Obj.repr _v;
+ MenhirLib.EngineTypes.startp = _startpos;
+ MenhirLib.EngineTypes.endp = _endpos;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ });
+ (fun _menhir_env ->
+ let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+ let {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _2;
+ MenhirLib.EngineTypes.startp = _startpos__2_;
+ MenhirLib.EngineTypes.endp = _endpos__2_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ };
+ } = _menhir_stack in
+ let _2 : unit = Obj.magic _2 in
+ let _1 : unit = Obj.magic _1 in
+ let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+ let _startpos = _startpos__1_ in
+ let _endpos = _endpos__2_ in
+ let _v : (Asttypes.variance * Asttypes.injectivity) =
+# 2955 "parsing/parser.mly"
+ ( Contravariant, Injective )
+# 44937 "parsing/parser.ml"
+ in
+ {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = Obj.repr _v;
+ MenhirLib.EngineTypes.startp = _startpos;
+ MenhirLib.EngineTypes.endp = _endpos;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ });
+ (fun _menhir_env ->
+ let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+ let {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _2;
+ MenhirLib.EngineTypes.startp = _startpos__2_;
+ MenhirLib.EngineTypes.endp = _endpos__2_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ };
+ } = _menhir_stack in
+ let _2 : unit = Obj.magic _2 in
+ let _1 : unit = Obj.magic _1 in
+ let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+ let _startpos = _startpos__1_ in
+ let _endpos = _endpos__2_ in
+ let _v : (Asttypes.variance * Asttypes.injectivity) =
+# 2955 "parsing/parser.mly"
+ ( Contravariant, Injective )
+# 44969 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos__1_;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
- let _1 : unit = Obj.magic _1 in
+ let _1 : (
+# 629 "parsing/parser.mly"
+ (string)
+# 44990 "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) =
-# 2946 "parsing/parser.mly"
- ( Covariant )
-# 44879 "parsing/parser.ml"
+ let _v : (Asttypes.variance * Asttypes.injectivity) = let _loc__1_ = (_startpos__1_, _endpos__1_) in
+
+# 2957 "parsing/parser.mly"
+ ( if _1 = "+!" then Covariant, Injective else
+ if _1 = "-!" then Contravariant, Injective else
+ expecting _loc__1_ "type_variance" )
+# 45001 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos__1_;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
- let _1 : unit = Obj.magic _1 in
+ let _1 : (
+# 675 "parsing/parser.mly"
+ (string)
+# 45022 "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) =
-# 2947 "parsing/parser.mly"
- ( Contravariant )
-# 44904 "parsing/parser.ml"
+ let _v : (Asttypes.variance * Asttypes.injectivity) = let _loc__1_ = (_startpos__1_, _endpos__1_) in
+
+# 2961 "parsing/parser.mly"
+ ( if _1 = "!+" then Covariant, Injective else
+ if _1 = "!-" then Contravariant, Injective else
+ expecting _loc__1_ "type_variance" )
+# 45033 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xss_ in
let _endpos = _endpos__2_ in
let _v : (
-# 783 "parsing/parser.mly"
+# 787 "parsing/parser.mly"
(Parsetree.toplevel_phrase list)
-# 44936 "parsing/parser.ml"
+# 45065 "parsing/parser.ml"
) = let _1 =
let _1 =
let ys =
# 260 "<standard.mly>"
( List.flatten xss )
-# 44942 "parsing/parser.ml"
+# 45071 "parsing/parser.ml"
in
let xs =
let _1 =
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( [] )
-# 44948 "parsing/parser.ml"
+# 45077 "parsing/parser.ml"
in
-# 1113 "parsing/parser.mly"
+# 1117 "parsing/parser.mly"
( _1 )
-# 44953 "parsing/parser.ml"
+# 45082 "parsing/parser.ml"
in
# 267 "<standard.mly>"
( xs @ ys )
-# 44959 "parsing/parser.ml"
+# 45088 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 809 "parsing/parser.mly"
+# 813 "parsing/parser.mly"
( extra_def _startpos _endpos _1 )
-# 44968 "parsing/parser.ml"
+# 45097 "parsing/parser.ml"
in
-# 1106 "parsing/parser.mly"
+# 1110 "parsing/parser.mly"
( _1 )
-# 44974 "parsing/parser.ml"
+# 45103 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_e_ in
let _endpos = _endpos__2_ in
let _v : (
-# 783 "parsing/parser.mly"
+# 787 "parsing/parser.mly"
(Parsetree.toplevel_phrase list)
-# 45020 "parsing/parser.ml"
+# 45149 "parsing/parser.ml"
) = let _1 =
let _1 =
let ys =
# 260 "<standard.mly>"
( List.flatten xss )
-# 45026 "parsing/parser.ml"
+# 45155 "parsing/parser.ml"
in
let xs =
let _1 =
let _1 =
let _1 =
let attrs =
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 45036 "parsing/parser.ml"
+# 45165 "parsing/parser.ml"
in
-# 1304 "parsing/parser.mly"
+# 1308 "parsing/parser.mly"
( mkstrexp e attrs )
-# 45041 "parsing/parser.ml"
+# 45170 "parsing/parser.ml"
in
-# 827 "parsing/parser.mly"
+# 831 "parsing/parser.mly"
( Ptop_def [_1] )
-# 45047 "parsing/parser.ml"
+# 45176 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_e_ in
let _startpos = _startpos__1_ in
-# 825 "parsing/parser.mly"
+# 829 "parsing/parser.mly"
( text_def _startpos @ [_1] )
-# 45055 "parsing/parser.ml"
+# 45184 "parsing/parser.ml"
in
-# 885 "parsing/parser.mly"
+# 889 "parsing/parser.mly"
( x )
-# 45061 "parsing/parser.ml"
+# 45190 "parsing/parser.ml"
in
-# 1113 "parsing/parser.mly"
+# 1117 "parsing/parser.mly"
( _1 )
-# 45067 "parsing/parser.ml"
+# 45196 "parsing/parser.ml"
in
# 267 "<standard.mly>"
( xs @ ys )
-# 45073 "parsing/parser.ml"
+# 45202 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_e_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 809 "parsing/parser.mly"
+# 813 "parsing/parser.mly"
( extra_def _startpos _endpos _1 )
-# 45082 "parsing/parser.ml"
+# 45211 "parsing/parser.ml"
in
-# 1106 "parsing/parser.mly"
+# 1110 "parsing/parser.mly"
( _1 )
-# 45088 "parsing/parser.ml"
+# 45217 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Asttypes.label) =
-# 3419 "parsing/parser.mly"
+# 3435 "parsing/parser.mly"
( _2 )
-# 45127 "parsing/parser.ml"
+# 45256 "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
-# 3420 "parsing/parser.mly"
+# 3436 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__3_ )
-# 45168 "parsing/parser.ml"
+# 45297 "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
-# 3421 "parsing/parser.mly"
+# 3437 "parsing/parser.mly"
( expecting _loc__2_ "operator" )
-# 45201 "parsing/parser.ml"
+# 45330 "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
-# 3422 "parsing/parser.mly"
+# 3438 "parsing/parser.mly"
( expecting _loc__3_ "module-expr" )
-# 45241 "parsing/parser.ml"
+# 45370 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 45262 "parsing/parser.ml"
+# 45391 "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) =
-# 3425 "parsing/parser.mly"
+# 3441 "parsing/parser.mly"
( _1 )
-# 45270 "parsing/parser.ml"
+# 45399 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) =
-# 3426 "parsing/parser.mly"
+# 3442 "parsing/parser.mly"
( _1 )
-# 45295 "parsing/parser.ml"
+# 45424 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3494 "parsing/parser.mly"
+# 3510 "parsing/parser.mly"
( _1 )
-# 45320 "parsing/parser.ml"
+# 45449 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let ty : (Parsetree.core_type) = Obj.magic ty in
let _5 : unit = Obj.magic _5 in
let _1_inlined1 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 45367 "parsing/parser.ml"
+# 45496 "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 =
-# 3393 "parsing/parser.mly"
+# 3409 "parsing/parser.mly"
( _1 )
-# 45381 "parsing/parser.ml"
+# 45510 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 45389 "parsing/parser.ml"
+# 45518 "parsing/parser.ml"
in
let attrs =
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 45395 "parsing/parser.ml"
+# 45524 "parsing/parser.ml"
in
let _1 =
-# 3630 "parsing/parser.mly"
+# 3646 "parsing/parser.mly"
( Fresh )
-# 45400 "parsing/parser.ml"
+# 45529 "parsing/parser.ml"
in
-# 1855 "parsing/parser.mly"
+# 1861 "parsing/parser.mly"
( (label, mutable_, Cfk_virtual ty), attrs )
-# 45405 "parsing/parser.ml"
+# 45534 "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_inlined1 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 45452 "parsing/parser.ml"
+# 45581 "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 =
-# 3393 "parsing/parser.mly"
+# 3409 "parsing/parser.mly"
( _1 )
-# 45466 "parsing/parser.ml"
+# 45595 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 45474 "parsing/parser.ml"
+# 45603 "parsing/parser.ml"
in
let _2 =
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 45480 "parsing/parser.ml"
+# 45609 "parsing/parser.ml"
in
let _1 =
-# 3633 "parsing/parser.mly"
+# 3649 "parsing/parser.mly"
( Fresh )
-# 45485 "parsing/parser.ml"
+# 45614 "parsing/parser.ml"
in
-# 1857 "parsing/parser.mly"
+# 1863 "parsing/parser.mly"
( (_4, _3, Cfk_concrete (_1, _6)), _2 )
-# 45490 "parsing/parser.ml"
+# 45619 "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_inlined2 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 45543 "parsing/parser.ml"
+# 45672 "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 =
-# 3393 "parsing/parser.mly"
+# 3409 "parsing/parser.mly"
( _1 )
-# 45558 "parsing/parser.ml"
+# 45687 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 45566 "parsing/parser.ml"
+# 45695 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 45574 "parsing/parser.ml"
+# 45703 "parsing/parser.ml"
in
let _1 =
-# 3634 "parsing/parser.mly"
+# 3650 "parsing/parser.mly"
( Override )
-# 45580 "parsing/parser.ml"
+# 45709 "parsing/parser.ml"
in
-# 1857 "parsing/parser.mly"
+# 1863 "parsing/parser.mly"
( (_4, _3, Cfk_concrete (_1, _6)), _2 )
-# 45585 "parsing/parser.ml"
+# 45714 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _6 : unit = Obj.magic _6 in
let _5 : (Parsetree.core_type option * Parsetree.core_type option) = Obj.magic _5 in
let _1_inlined1 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 45639 "parsing/parser.ml"
+# 45768 "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 =
-# 3393 "parsing/parser.mly"
+# 3409 "parsing/parser.mly"
( _1 )
-# 45653 "parsing/parser.ml"
+# 45782 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 45661 "parsing/parser.ml"
+# 45790 "parsing/parser.ml"
in
let _startpos__4_ = _startpos__1_inlined1_ in
let _2 =
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 45668 "parsing/parser.ml"
+# 45797 "parsing/parser.ml"
in
let (_endpos__2_, _startpos__2_) = (_endpos__1_, _startpos__1_) in
let _1 =
-# 3633 "parsing/parser.mly"
+# 3649 "parsing/parser.mly"
( Fresh )
-# 45674 "parsing/parser.ml"
+# 45803 "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
-# 1860 "parsing/parser.mly"
+# 1866 "parsing/parser.mly"
( let e = mkexp_constraint ~loc:_sloc _7 _5 in
(_4, _3, Cfk_concrete (_1, e)), _2
)
-# 45694 "parsing/parser.ml"
+# 45823 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _6 : unit = Obj.magic _6 in
let _5 : (Parsetree.core_type option * Parsetree.core_type option) = Obj.magic _5 in
let _1_inlined2 : (
-# 647 "parsing/parser.mly"
+# 651 "parsing/parser.mly"
(string)
-# 45754 "parsing/parser.ml"
+# 45883 "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 =
-# 3393 "parsing/parser.mly"
+# 3409 "parsing/parser.mly"
( _1 )
-# 45769 "parsing/parser.ml"
+# 45898 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 45777 "parsing/parser.ml"
+# 45906 "parsing/parser.ml"
in
let _startpos__4_ = _startpos__1_inlined2_ in
let _2 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 45786 "parsing/parser.ml"
+# 45915 "parsing/parser.ml"
in
let (_endpos__2_, _startpos__2_) = (_endpos__1_inlined1_, _startpos__1_inlined1_) in
let _1 =
-# 3634 "parsing/parser.mly"
+# 3650 "parsing/parser.mly"
( Override )
-# 45793 "parsing/parser.ml"
+# 45922 "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
-# 1860 "parsing/parser.mly"
+# 1866 "parsing/parser.mly"
( let e = mkexp_constraint ~loc:_sloc _7 _5 in
(_4, _3, Cfk_concrete (_1, e)), _2
)
-# 45812 "parsing/parser.ml"
+# 45941 "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
-# 3727 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
( _1 )
-# 45881 "parsing/parser.ml"
+# 46010 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 45893 "parsing/parser.ml"
+# 46022 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3731 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( _1 )
-# 45901 "parsing/parser.ml"
+# 46030 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2787 "parsing/parser.mly"
+# 2792 "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 )
-# 45914 "parsing/parser.ml"
+# 46043 "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) =
-# 3594 "parsing/parser.mly"
+# 3610 "parsing/parser.mly"
( Concrete )
-# 45932 "parsing/parser.ml"
+# 46061 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.virtual_flag) =
-# 3595 "parsing/parser.mly"
+# 3611 "parsing/parser.mly"
( Virtual )
-# 45957 "parsing/parser.ml"
+# 46086 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.mutable_flag) =
-# 3618 "parsing/parser.mly"
+# 3634 "parsing/parser.mly"
( Immutable )
-# 45982 "parsing/parser.ml"
+# 46111 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.mutable_flag) =
-# 3619 "parsing/parser.mly"
+# 3635 "parsing/parser.mly"
( Mutable )
-# 46014 "parsing/parser.ml"
+# 46143 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.mutable_flag) =
-# 3620 "parsing/parser.mly"
+# 3636 "parsing/parser.mly"
( Mutable )
-# 46046 "parsing/parser.ml"
+# 46175 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.private_flag) =
-# 3625 "parsing/parser.mly"
+# 3641 "parsing/parser.mly"
( Public )
-# 46071 "parsing/parser.ml"
+# 46200 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.private_flag) =
-# 3626 "parsing/parser.mly"
+# 3642 "parsing/parser.mly"
( Private )
-# 46103 "parsing/parser.ml"
+# 46232 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.private_flag) =
-# 3627 "parsing/parser.mly"
+# 3643 "parsing/parser.mly"
( Private )
-# 46135 "parsing/parser.ml"
+# 46264 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in
let _4 : (Asttypes.private_flag) = Obj.magic _4 in
let _1_inlined1 : (Longident.t) = Obj.magic _1_inlined1 in
- let _2 : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic _2 in
+ let _2 : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = 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 xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 46197 "parsing/parser.ml"
+# 46326 "parsing/parser.ml"
in
-# 897 "parsing/parser.mly"
+# 901 "parsing/parser.mly"
( xs )
-# 46202 "parsing/parser.ml"
+# 46331 "parsing/parser.ml"
in
-# 2887 "parsing/parser.mly"
+# 2892 "parsing/parser.mly"
( _1 )
-# 46208 "parsing/parser.ml"
+# 46337 "parsing/parser.ml"
in
let _endpos__6_ = _endpos_xs_ in
let _5 =
let _1 = _1_inlined2 in
-# 3189 "parsing/parser.mly"
+# 3205 "parsing/parser.mly"
( _1 )
-# 46217 "parsing/parser.ml"
+# 46346 "parsing/parser.ml"
in
let _3 =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 46228 "parsing/parser.ml"
+# 46357 "parsing/parser.ml"
in
let _endpos = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3112 "parsing/parser.mly"
+# 3128 "parsing/parser.mly"
( let lident = loc_last _3 in
Pwith_type
(_3,
~manifest:_5
~priv:_4
~loc:(make_loc _sloc))) )
-# 46245 "parsing/parser.ml"
+# 46374 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in
let _4 : unit = Obj.magic _4 in
let _1_inlined1 : (Longident.t) = Obj.magic _1_inlined1 in
- let _2 : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic _2 in
+ let _2 : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = 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 _v : (Parsetree.with_constraint) = let _5 =
let _1 = _1_inlined2 in
-# 3189 "parsing/parser.mly"
+# 3205 "parsing/parser.mly"
( _1 )
-# 46300 "parsing/parser.ml"
+# 46429 "parsing/parser.ml"
in
let _endpos__5_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 46312 "parsing/parser.ml"
+# 46441 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3125 "parsing/parser.mly"
+# 3141 "parsing/parser.mly"
( let lident = loc_last _3 in
Pwith_typesubst
(_3,
~params:_2
~manifest:_5
~loc:(make_loc _sloc))) )
-# 46327 "parsing/parser.ml"
+# 46456 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 46378 "parsing/parser.ml"
+# 46507 "parsing/parser.ml"
in
let _2 =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 46389 "parsing/parser.ml"
+# 46518 "parsing/parser.ml"
in
-# 3133 "parsing/parser.mly"
+# 3149 "parsing/parser.mly"
( Pwith_module (_2, _4) )
-# 46395 "parsing/parser.ml"
+# 46524 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 46446 "parsing/parser.ml"
+# 46575 "parsing/parser.ml"
in
let _2 =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 813 "parsing/parser.mly"
+# 817 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 46457 "parsing/parser.ml"
+# 46586 "parsing/parser.ml"
in
-# 3135 "parsing/parser.mly"
+# 3151 "parsing/parser.mly"
( Pwith_modsubst (_2, _4) )
-# 46463 "parsing/parser.ml"
+# 46592 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.private_flag) =
-# 3138 "parsing/parser.mly"
+# 3154 "parsing/parser.mly"
( Public )
-# 46488 "parsing/parser.ml"
+# 46617 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.private_flag) =
-# 3139 "parsing/parser.mly"
+# 3155 "parsing/parser.mly"
( Private )
-# 46520 "parsing/parser.ml"
+# 46649 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let use_file =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry 1802 lexer lexbuf) : (
-# 783 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.entry 1809 lexer lexbuf) : (
+# 787 "parsing/parser.mly"
(Parsetree.toplevel_phrase list)
-# 46551 "parsing/parser.ml"
+# 46680 "parsing/parser.ml"
))
and toplevel_phrase =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry 1782 lexer lexbuf) : (
-# 781 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.entry 1789 lexer lexbuf) : (
+# 785 "parsing/parser.mly"
(Parsetree.toplevel_phrase)
-# 46559 "parsing/parser.ml"
+# 46688 "parsing/parser.ml"
))
and parse_val_longident =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry 1776 lexer lexbuf) : (
-# 793 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.entry 1783 lexer lexbuf) : (
+# 797 "parsing/parser.mly"
(Longident.t)
-# 46567 "parsing/parser.ml"
+# 46696 "parsing/parser.ml"
))
and parse_pattern =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry 1772 lexer lexbuf) : (
-# 789 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.entry 1779 lexer lexbuf) : (
+# 793 "parsing/parser.mly"
(Parsetree.pattern)
-# 46575 "parsing/parser.ml"
+# 46704 "parsing/parser.ml"
))
and parse_mty_longident =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry 1768 lexer lexbuf) : (
-# 795 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.entry 1775 lexer lexbuf) : (
+# 799 "parsing/parser.mly"
(Longident.t)
-# 46583 "parsing/parser.ml"
+# 46712 "parsing/parser.ml"
))
and parse_mod_longident =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry 1764 lexer lexbuf) : (
-# 799 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.entry 1771 lexer lexbuf) : (
+# 803 "parsing/parser.mly"
(Longident.t)
-# 46591 "parsing/parser.ml"
+# 46720 "parsing/parser.ml"
))
and parse_mod_ext_longident =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry 1760 lexer lexbuf) : (
-# 797 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.entry 1767 lexer lexbuf) : (
+# 801 "parsing/parser.mly"
(Longident.t)
-# 46599 "parsing/parser.ml"
+# 46728 "parsing/parser.ml"
))
and parse_expression =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry 1756 lexer lexbuf) : (
-# 787 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.entry 1763 lexer lexbuf) : (
+# 791 "parsing/parser.mly"
(Parsetree.expression)
-# 46607 "parsing/parser.ml"
+# 46736 "parsing/parser.ml"
))
and parse_core_type =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry 1752 lexer lexbuf) : (
-# 785 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.entry 1759 lexer lexbuf) : (
+# 789 "parsing/parser.mly"
(Parsetree.core_type)
-# 46615 "parsing/parser.ml"
+# 46744 "parsing/parser.ml"
))
and parse_constr_longident =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry 1748 lexer lexbuf) : (
-# 791 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.entry 1755 lexer lexbuf) : (
+# 795 "parsing/parser.mly"
(Longident.t)
-# 46623 "parsing/parser.ml"
+# 46752 "parsing/parser.ml"
))
and parse_any_longident =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry 1730 lexer lexbuf) : (
-# 801 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.entry 1737 lexer lexbuf) : (
+# 805 "parsing/parser.mly"
(Longident.t)
-# 46631 "parsing/parser.ml"
+# 46760 "parsing/parser.ml"
))
and interface =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry 1726 lexer lexbuf) : (
-# 779 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.entry 1733 lexer lexbuf) : (
+# 783 "parsing/parser.mly"
(Parsetree.signature)
-# 46639 "parsing/parser.ml"
+# 46768 "parsing/parser.ml"
))
and implementation =
fun lexer lexbuf ->
(Obj.magic (MenhirInterpreter.entry 0 lexer lexbuf) : (
-# 777 "parsing/parser.mly"
+# 781 "parsing/parser.mly"
(Parsetree.structure)
-# 46647 "parsing/parser.ml"
+# 46776 "parsing/parser.ml"
))
module Incremental = struct
let use_file =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1802 initial_position) : (
-# 783 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.start 1809 initial_position) : (
+# 787 "parsing/parser.mly"
(Parsetree.toplevel_phrase list)
-# 46657 "parsing/parser.ml"
+# 46786 "parsing/parser.ml"
) MenhirInterpreter.checkpoint)
and toplevel_phrase =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1782 initial_position) : (
-# 781 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.start 1789 initial_position) : (
+# 785 "parsing/parser.mly"
(Parsetree.toplevel_phrase)
-# 46665 "parsing/parser.ml"
+# 46794 "parsing/parser.ml"
) MenhirInterpreter.checkpoint)
and parse_val_longident =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1776 initial_position) : (
-# 793 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.start 1783 initial_position) : (
+# 797 "parsing/parser.mly"
(Longident.t)
-# 46673 "parsing/parser.ml"
+# 46802 "parsing/parser.ml"
) MenhirInterpreter.checkpoint)
and parse_pattern =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1772 initial_position) : (
-# 789 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.start 1779 initial_position) : (
+# 793 "parsing/parser.mly"
(Parsetree.pattern)
-# 46681 "parsing/parser.ml"
+# 46810 "parsing/parser.ml"
) MenhirInterpreter.checkpoint)
and parse_mty_longident =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1768 initial_position) : (
-# 795 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.start 1775 initial_position) : (
+# 799 "parsing/parser.mly"
(Longident.t)
-# 46689 "parsing/parser.ml"
+# 46818 "parsing/parser.ml"
) MenhirInterpreter.checkpoint)
and parse_mod_longident =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1764 initial_position) : (
-# 799 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.start 1771 initial_position) : (
+# 803 "parsing/parser.mly"
(Longident.t)
-# 46697 "parsing/parser.ml"
+# 46826 "parsing/parser.ml"
) MenhirInterpreter.checkpoint)
and parse_mod_ext_longident =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1760 initial_position) : (
-# 797 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.start 1767 initial_position) : (
+# 801 "parsing/parser.mly"
(Longident.t)
-# 46705 "parsing/parser.ml"
+# 46834 "parsing/parser.ml"
) MenhirInterpreter.checkpoint)
and parse_expression =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1756 initial_position) : (
-# 787 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.start 1763 initial_position) : (
+# 791 "parsing/parser.mly"
(Parsetree.expression)
-# 46713 "parsing/parser.ml"
+# 46842 "parsing/parser.ml"
) MenhirInterpreter.checkpoint)
and parse_core_type =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1752 initial_position) : (
-# 785 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.start 1759 initial_position) : (
+# 789 "parsing/parser.mly"
(Parsetree.core_type)
-# 46721 "parsing/parser.ml"
+# 46850 "parsing/parser.ml"
) MenhirInterpreter.checkpoint)
and parse_constr_longident =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1748 initial_position) : (
-# 791 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.start 1755 initial_position) : (
+# 795 "parsing/parser.mly"
(Longident.t)
-# 46729 "parsing/parser.ml"
+# 46858 "parsing/parser.ml"
) MenhirInterpreter.checkpoint)
and parse_any_longident =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1730 initial_position) : (
-# 801 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.start 1737 initial_position) : (
+# 805 "parsing/parser.mly"
(Longident.t)
-# 46737 "parsing/parser.ml"
+# 46866 "parsing/parser.ml"
) MenhirInterpreter.checkpoint)
and interface =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1726 initial_position) : (
-# 779 "parsing/parser.mly"
+ (Obj.magic (MenhirInterpreter.start 1733 initial_position) : (
+# 783 "parsing/parser.mly"
(Parsetree.signature)
-# 46745 "parsing/parser.ml"
+# 46874 "parsing/parser.ml"
) MenhirInterpreter.checkpoint)
and implementation =
fun initial_position ->
(Obj.magic (MenhirInterpreter.start 0 initial_position) : (
-# 777 "parsing/parser.mly"
+# 781 "parsing/parser.mly"
(Parsetree.structure)
-# 46753 "parsing/parser.ml"
+# 46882 "parsing/parser.ml"
) MenhirInterpreter.checkpoint)
end
-# 3761 "parsing/parser.mly"
+# 3777 "parsing/parser.mly"
-# 46761 "parsing/parser.ml"
+# 46890 "parsing/parser.ml"
# 269 "<standard.mly>"
-# 46766 "parsing/parser.ml"
+# 46895 "parsing/parser.ml"
#! /bin/sh
# Attempt to guess a canonical system name.
-# Copyright 1992-2018 Free Software Foundation, Inc.
+# Copyright 1992-2020 Free Software Foundation, Inc.
-timestamp='2018-02-24'
+timestamp='2020-07-12'
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
GNU config.guess ($timestamp)
Originally written by Per Bothner.
-Copyright 1992-2018 Free Software Foundation, Inc.
+Copyright 1992-2020 Free Software Foundation, Inc.
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
exit 1
fi
-trap 'exit 1' 1 2 15
-
# CC_FOR_BUILD -- compiler used by this script. Note that the use of a
# compiler to aid in system detection is discouraged as it requires
# temporary files to be created and, as you can see below, it is a
# Portable tmp directory creation inspired by the Autoconf team.
-set_cc_for_build='
-trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ;
-trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ;
-: ${TMPDIR=/tmp} ;
- { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } ||
- { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } ||
- { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } ||
- { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ;
-dummy=$tmp/dummy ;
-tmpfiles="$dummy.c $dummy.o $dummy.rel $dummy" ;
-case $CC_FOR_BUILD,$HOST_CC,$CC in
- ,,) echo "int x;" > "$dummy.c" ;
- for c in cc gcc c89 c99 ; do
- if ($c -c -o "$dummy.o" "$dummy.c") >/dev/null 2>&1 ; then
- CC_FOR_BUILD="$c"; break ;
- fi ;
- done ;
- if test x"$CC_FOR_BUILD" = x ; then
- CC_FOR_BUILD=no_compiler_found ;
- fi
- ;;
- ,,*) CC_FOR_BUILD=$CC ;;
- ,*,*) CC_FOR_BUILD=$HOST_CC ;;
-esac ; set_cc_for_build= ;'
+tmp=
+# shellcheck disable=SC2172
+trap 'test -z "$tmp" || rm -fr "$tmp"' 0 1 2 13 15
+
+set_cc_for_build() {
+ # prevent multiple calls if $tmp is already set
+ test "$tmp" && return 0
+ : "${TMPDIR=/tmp}"
+ # shellcheck disable=SC2039
+ { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } ||
+ { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir "$tmp" 2>/dev/null) ; } ||
+ { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir "$tmp" 2>/dev/null) && echo "Warning: creating insecure temp directory" >&2 ; } ||
+ { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; }
+ dummy=$tmp/dummy
+ case ${CC_FOR_BUILD-},${HOST_CC-},${CC-} in
+ ,,) echo "int x;" > "$dummy.c"
+ for driver in cc gcc c89 c99 ; do
+ if ($driver -c -o "$dummy.o" "$dummy.c") >/dev/null 2>&1 ; then
+ CC_FOR_BUILD="$driver"
+ break
+ fi
+ done
+ if test x"$CC_FOR_BUILD" = x ; then
+ CC_FOR_BUILD=no_compiler_found
+ fi
+ ;;
+ ,,*) CC_FOR_BUILD=$CC ;;
+ ,*,*) CC_FOR_BUILD=$HOST_CC ;;
+ esac
+}
# This is needed to find uname on a Pyramid OSx when run in the BSD universe.
# (ghazi@noc.rutgers.edu 1994-08-24)
-if (test -f /.attbin/uname) >/dev/null 2>&1 ; then
+if test -f /.attbin/uname ; then
PATH=$PATH:/.attbin ; export PATH
fi
# We could probably try harder.
LIBC=gnu
- eval "$set_cc_for_build"
+ set_cc_for_build
cat <<-EOF > "$dummy.c"
#include <features.h>
#if defined(__UCLIBC__)
os=netbsdelf
;;
arm*|i386|m68k|ns32k|sh3*|sparc|vax)
- eval "$set_cc_for_build"
+ set_cc_for_build
if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \
| grep -q __ELF__
then
# Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM:
# contains redundant information, the shorter form:
# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used.
- echo "$machine-${os}${release}${abi}"
+ echo "$machine-${os}${release}${abi-}"
exit ;;
*:Bitrig:*:*)
UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'`
*:SolidBSD:*:*)
echo "$UNAME_MACHINE"-unknown-solidbsd"$UNAME_RELEASE"
exit ;;
+ *:OS108:*:*)
+ echo "$UNAME_MACHINE"-unknown-os108_"$UNAME_RELEASE"
+ exit ;;
macppc:MirBSD:*:*)
echo powerpc-unknown-mirbsd"$UNAME_RELEASE"
exit ;;
*:Sortix:*:*)
echo "$UNAME_MACHINE"-unknown-sortix
exit ;;
+ *:Twizzler:*:*)
+ echo "$UNAME_MACHINE"-unknown-twizzler
+ exit ;;
*:Redox:*:*)
echo "$UNAME_MACHINE"-unknown-redox
exit ;;
mips:OSF1:*.*)
- echo mips-dec-osf1
- exit ;;
+ echo mips-dec-osf1
+ exit ;;
alpha:OSF1:*:*)
case $UNAME_RELEASE in
*4.0)
echo i386-pc-auroraux"$UNAME_RELEASE"
exit ;;
i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*)
- eval "$set_cc_for_build"
+ set_cc_for_build
SUN_ARCH=i386
# If there is a compiler, see if it is configured for 64-bit objects.
# Note that the Sun cc does not turn __LP64__ into 1 like gcc does.
echo clipper-intergraph-clix"$UNAME_RELEASE"
exit ;;
mips:*:*:UMIPS | mips:*:*:RISCos)
- eval "$set_cc_for_build"
+ set_cc_for_build
sed 's/^ //' << EOF > "$dummy.c"
#ifdef __cplusplus
#include <stdio.h> /* for printf() prototype */
exit ;;
*:AIX:2:3)
if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then
- eval "$set_cc_for_build"
+ set_cc_for_build
sed 's/^ //' << EOF > "$dummy.c"
#include <sys/systemcfg.h>
esac
fi
if [ "$HP_ARCH" = "" ]; then
- eval "$set_cc_for_build"
+ set_cc_for_build
sed 's/^ //' << EOF > "$dummy.c"
#define _HPUX_SOURCE
esac
if [ "$HP_ARCH" = hppa2.0w ]
then
- eval "$set_cc_for_build"
+ set_cc_for_build
# hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating
# 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler
echo ia64-hp-hpux"$HPUX_REV"
exit ;;
3050*:HI-UX:*:*)
- eval "$set_cc_for_build"
+ set_cc_for_build
sed 's/^ //' << EOF > "$dummy.c"
#include <unistd.h>
int
*:BSD/OS:*:*)
echo "$UNAME_MACHINE"-unknown-bsdi"$UNAME_RELEASE"
exit ;;
+ arm:FreeBSD:*:*)
+ UNAME_PROCESSOR=`uname -p`
+ set_cc_for_build
+ if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \
+ | grep -q __ARM_PCS_VFP
+ then
+ echo "${UNAME_PROCESSOR}"-unknown-freebsd"`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`"-gnueabi
+ else
+ echo "${UNAME_PROCESSOR}"-unknown-freebsd"`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`"-gnueabihf
+ fi
+ exit ;;
*:FreeBSD:*:*)
UNAME_PROCESSOR=`/usr/bin/uname -p`
case "$UNAME_PROCESSOR" in
echo "$UNAME_MACHINE"-pc-uwin
exit ;;
amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*)
- echo x86_64-unknown-cygwin
+ echo x86_64-pc-cygwin
exit ;;
prep*:SunOS:5.*:*)
echo powerpcle-unknown-solaris2"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`"
# other systems with GNU libc and userland
echo "$UNAME_MACHINE-unknown-`echo "$UNAME_SYSTEM" | sed 's,^[^/]*/,,' | tr "[:upper:]" "[:lower:]"``echo "$UNAME_RELEASE"|sed -e 's/[-(].*//'`-$LIBC"
exit ;;
- i*86:Minix:*:*)
- echo "$UNAME_MACHINE"-pc-minix
+ *:Minix:*:*)
+ echo "$UNAME_MACHINE"-unknown-minix
exit ;;
aarch64:Linux:*:*)
echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
exit ;;
alpha:Linux:*:*)
- case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in
+ case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' /proc/cpuinfo 2>/dev/null` in
EV5) UNAME_MACHINE=alphaev5 ;;
EV56) UNAME_MACHINE=alphaev56 ;;
PCA56) UNAME_MACHINE=alphapca56 ;;
echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
exit ;;
arm*:Linux:*:*)
- eval "$set_cc_for_build"
+ set_cc_for_build
if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \
| grep -q __ARM_EABI__
then
echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
exit ;;
mips:Linux:*:* | mips64:Linux:*:*)
- eval "$set_cc_for_build"
+ set_cc_for_build
+ IS_GLIBC=0
+ test x"${LIBC}" = xgnu && IS_GLIBC=1
sed 's/^ //' << EOF > "$dummy.c"
#undef CPU
- #undef ${UNAME_MACHINE}
- #undef ${UNAME_MACHINE}el
+ #undef mips
+ #undef mipsel
+ #undef mips64
+ #undef mips64el
+ #if ${IS_GLIBC} && defined(_ABI64)
+ LIBCABI=gnuabi64
+ #else
+ #if ${IS_GLIBC} && defined(_ABIN32)
+ LIBCABI=gnuabin32
+ #else
+ LIBCABI=${LIBC}
+ #endif
+ #endif
+
+ #if ${IS_GLIBC} && defined(__mips64) && defined(__mips_isa_rev) && __mips_isa_rev>=6
+ CPU=mipsisa64r6
+ #else
+ #if ${IS_GLIBC} && !defined(__mips64) && defined(__mips_isa_rev) && __mips_isa_rev>=6
+ CPU=mipsisa32r6
+ #else
+ #if defined(__mips64)
+ CPU=mips64
+ #else
+ CPU=mips
+ #endif
+ #endif
+ #endif
+
#if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL)
- CPU=${UNAME_MACHINE}el
+ MIPS_ENDIAN=el
#else
#if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB)
- CPU=${UNAME_MACHINE}
+ MIPS_ENDIAN=
#else
- CPU=
+ MIPS_ENDIAN=
#endif
#endif
EOF
- eval "`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^CPU'`"
- test "x$CPU" != x && { echo "$CPU-unknown-linux-$LIBC"; exit; }
+ eval "`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^CPU\|^MIPS_ENDIAN\|^LIBCABI'`"
+ test "x$CPU" != x && { echo "$CPU${MIPS_ENDIAN}-unknown-linux-$LIBCABI"; exit; }
;;
mips64el:Linux:*:*)
echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
echo "$UNAME_MACHINE"-dec-linux-"$LIBC"
exit ;;
x86_64:Linux:*:*)
- if objdump -f /bin/sh | grep -q elf32-x86-64; then
- echo "$UNAME_MACHINE"-pc-linux-"$LIBC"x32
- else
- echo "$UNAME_MACHINE"-pc-linux-"$LIBC"
+ set_cc_for_build
+ LIBCABI=$LIBC
+ if [ "$CC_FOR_BUILD" != no_compiler_found ]; then
+ if (echo '#ifdef __ILP32__'; echo IS_X32; echo '#endif') | \
+ (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \
+ grep IS_X32 >/dev/null
+ then
+ LIBCABI="$LIBC"x32
+ fi
fi
+ echo "$UNAME_MACHINE"-pc-linux-"$LIBCABI"
exit ;;
xtensa*:Linux:*:*)
echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
*Pentium) UNAME_MACHINE=i586 ;;
*Pent*|*Celeron) UNAME_MACHINE=i686 ;;
esac
- echo "$UNAME_MACHINE-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}{$UNAME_VERSION}"
+ echo "$UNAME_MACHINE-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION}"
exit ;;
i*86:*:3.2:*)
if test -f /usr/options/cb.name; then
*:Rhapsody:*:*)
echo "$UNAME_MACHINE"-apple-rhapsody"$UNAME_RELEASE"
exit ;;
+ arm64:Darwin:*:*)
+ echo aarch64-apple-darwin"$UNAME_RELEASE"
+ exit ;;
*:Darwin:*:*)
- UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown
- eval "$set_cc_for_build"
- if test "$UNAME_PROCESSOR" = unknown ; then
- UNAME_PROCESSOR=powerpc
+ UNAME_PROCESSOR=`uname -p`
+ case $UNAME_PROCESSOR in
+ unknown) UNAME_PROCESSOR=powerpc ;;
+ esac
+ if command -v xcode-select > /dev/null 2> /dev/null && \
+ ! xcode-select --print-path > /dev/null 2> /dev/null ; then
+ # Avoid executing cc if there is no toolchain installed as
+ # cc will be a stub that puts up a graphical alert
+ # prompting the user to install developer tools.
+ CC_FOR_BUILD=no_compiler_found
+ else
+ set_cc_for_build
fi
- if test "`echo "$UNAME_RELEASE" | sed -e 's/\..*//'`" -le 10 ; then
- if [ "$CC_FOR_BUILD" != no_compiler_found ]; then
- if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \
- (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \
- grep IS_64BIT_ARCH >/dev/null
- then
- case $UNAME_PROCESSOR in
- i386) UNAME_PROCESSOR=x86_64 ;;
- powerpc) UNAME_PROCESSOR=powerpc64 ;;
- esac
- fi
- # On 10.4-10.6 one might compile for PowerPC via gcc -arch ppc
- if (echo '#ifdef __POWERPC__'; echo IS_PPC; echo '#endif') | \
- (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \
- grep IS_PPC >/dev/null
- then
- UNAME_PROCESSOR=powerpc
- fi
+ if [ "$CC_FOR_BUILD" != no_compiler_found ]; then
+ if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \
+ (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \
+ grep IS_64BIT_ARCH >/dev/null
+ then
+ case $UNAME_PROCESSOR in
+ i386) UNAME_PROCESSOR=x86_64 ;;
+ powerpc) UNAME_PROCESSOR=powerpc64 ;;
+ esac
+ fi
+ # On 10.4-10.6 one might compile for PowerPC via gcc -arch ppc
+ if (echo '#ifdef __POWERPC__'; echo IS_PPC; echo '#endif') | \
+ (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \
+ grep IS_PPC >/dev/null
+ then
+ UNAME_PROCESSOR=powerpc
fi
elif test "$UNAME_PROCESSOR" = i386 ; then
- # Avoid executing cc on OS X 10.9, as it ships with a stub
- # that puts up a graphical alert prompting to install
- # developer tools. Any system running Mac OS X 10.7 or
- # later (Darwin 11 and later) is required to have a 64-bit
- # processor. This is not true of the ARM version of Darwin
- # that Apple uses in portable devices.
- UNAME_PROCESSOR=x86_64
+ # uname -m returns i386 or x86_64
+ UNAME_PROCESSOR=$UNAME_MACHINE
fi
echo "$UNAME_PROCESSOR"-apple-darwin"$UNAME_RELEASE"
exit ;;
# "uname -m" is not consistent, so use $cputype instead. 386
# is converted to i386 for consistency with other x86
# operating systems.
+ # shellcheck disable=SC2154
if test "$cputype" = 386; then
UNAME_MACHINE=i386
else
amd64:Isilon\ OneFS:*:*)
echo x86_64-unknown-onefs
exit ;;
+ *:Unleashed:*:*)
+ echo "$UNAME_MACHINE"-unknown-unleashed"$UNAME_RELEASE"
+ exit ;;
esac
+# No uname command or uname output not recognized.
+set_cc_for_build
+cat > "$dummy.c" <<EOF
+#ifdef _SEQUENT_
+#include <sys/types.h>
+#include <sys/utsname.h>
+#endif
+#if defined(ultrix) || defined(_ultrix) || defined(__ultrix) || defined(__ultrix__)
+#if defined (vax) || defined (__vax) || defined (__vax__) || defined(mips) || defined(__mips) || defined(__mips__) || defined(MIPS) || defined(__MIPS__)
+#include <signal.h>
+#if defined(_SIZE_T_) || defined(SIGLOST)
+#include <sys/utsname.h>
+#endif
+#endif
+#endif
+main ()
+{
+#if defined (sony)
+#if defined (MIPSEB)
+ /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed,
+ I don't know.... */
+ printf ("mips-sony-bsd\n"); exit (0);
+#else
+#include <sys/param.h>
+ printf ("m68k-sony-newsos%s\n",
+#ifdef NEWSOS4
+ "4"
+#else
+ ""
+#endif
+ ); exit (0);
+#endif
+#endif
+
+#if defined (NeXT)
+#if !defined (__ARCHITECTURE__)
+#define __ARCHITECTURE__ "m68k"
+#endif
+ int version;
+ version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`;
+ if (version < 4)
+ printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version);
+ else
+ printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version);
+ exit (0);
+#endif
+
+#if defined (MULTIMAX) || defined (n16)
+#if defined (UMAXV)
+ printf ("ns32k-encore-sysv\n"); exit (0);
+#else
+#if defined (CMU)
+ printf ("ns32k-encore-mach\n"); exit (0);
+#else
+ printf ("ns32k-encore-bsd\n"); exit (0);
+#endif
+#endif
+#endif
+
+#if defined (__386BSD__)
+ printf ("i386-pc-bsd\n"); exit (0);
+#endif
+
+#if defined (sequent)
+#if defined (i386)
+ printf ("i386-sequent-dynix\n"); exit (0);
+#endif
+#if defined (ns32000)
+ printf ("ns32k-sequent-dynix\n"); exit (0);
+#endif
+#endif
+
+#if defined (_SEQUENT_)
+ struct utsname un;
+
+ uname(&un);
+ if (strncmp(un.version, "V2", 2) == 0) {
+ printf ("i386-sequent-ptx2\n"); exit (0);
+ }
+ if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */
+ printf ("i386-sequent-ptx1\n"); exit (0);
+ }
+ printf ("i386-sequent-ptx\n"); exit (0);
+#endif
+
+#if defined (vax)
+#if !defined (ultrix)
+#include <sys/param.h>
+#if defined (BSD)
+#if BSD == 43
+ printf ("vax-dec-bsd4.3\n"); exit (0);
+#else
+#if BSD == 199006
+ printf ("vax-dec-bsd4.3reno\n"); exit (0);
+#else
+ printf ("vax-dec-bsd\n"); exit (0);
+#endif
+#endif
+#else
+ printf ("vax-dec-bsd\n"); exit (0);
+#endif
+#else
+#if defined(_SIZE_T_) || defined(SIGLOST)
+ struct utsname un;
+ uname (&un);
+ printf ("vax-dec-ultrix%s\n", un.release); exit (0);
+#else
+ printf ("vax-dec-ultrix\n"); exit (0);
+#endif
+#endif
+#endif
+#if defined(ultrix) || defined(_ultrix) || defined(__ultrix) || defined(__ultrix__)
+#if defined(mips) || defined(__mips) || defined(__mips__) || defined(MIPS) || defined(__MIPS__)
+#if defined(_SIZE_T_) || defined(SIGLOST)
+ struct utsname *un;
+ uname (&un);
+ printf ("mips-dec-ultrix%s\n", un.release); exit (0);
+#else
+ printf ("mips-dec-ultrix\n"); exit (0);
+#endif
+#endif
+#endif
+
+#if defined (alliant) && defined (i860)
+ printf ("i860-alliant-bsd\n"); exit (0);
+#endif
+
+ exit (1);
+}
+EOF
+
+$CC_FOR_BUILD -o "$dummy" "$dummy.c" 2>/dev/null && SYSTEM_NAME=`$dummy` &&
+ { echo "$SYSTEM_NAME"; exit; }
+
+# Apollos put the system type in the environment.
+test -d /usr/apollo && { echo "$ISP-apollo-$SYSTYPE"; exit; }
+
echo "$0: unable to guess system type" >&2
case "$UNAME_MACHINE:$UNAME_SYSTEM" in
https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess
and
https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub
+EOF
+
+year=`echo $timestamp | sed 's,-.*,,'`
+# shellcheck disable=SC2003
+if test "`expr "\`date +%Y\`" - "$year"`" -lt 3 ; then
+ cat >&2 <<EOF
If $0 has already been updated, send the following data and any
information you think might be pertinent to config-patches@gnu.org to
UNAME_SYSTEM = "$UNAME_SYSTEM"
UNAME_VERSION = "$UNAME_VERSION"
EOF
+fi
exit 1
# Local variables:
-# eval: (add-hook 'write-file-functions 'time-stamp)
+# eval: (add-hook 'before-save-hook 'time-stamp)
# time-stamp-start: "timestamp='"
# time-stamp-format: "%:y-%02m-%02d"
# time-stamp-end: "'"
#! /bin/sh
# Configuration validation subroutine script.
-# Copyright 1992-2018 Free Software Foundation, Inc.
+# Copyright 1992-2020 Free Software Foundation, Inc.
-timestamp='2018-02-22'
+timestamp='2020-07-10'
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
version="\
GNU config.sub ($timestamp)
-Copyright 1992-2018 Free Software Foundation, Inc.
+Copyright 1992-2020 Free Software Foundation, Inc.
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
- ) # Use stdin as input.
break ;;
-* )
- echo "$me: invalid option $1$help"
+ echo "$me: invalid option $1$help" >&2
exit 1 ;;
*local*)
exit 1;;
esac
-# Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any).
-# Here we must recognize all the valid KERNEL-OS combinations.
-maybe_os=`echo "$1" | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'`
-case $maybe_os in
- nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \
- linux-musl* | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \
- knetbsd*-gnu* | netbsd*-gnu* | netbsd*-eabi* | \
- kopensolaris*-gnu* | cloudabi*-eabi* | \
- storm-chaos* | os2-emx* | rtmk-nova*)
- os=-$maybe_os
- basic_machine=`echo "$1" | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`
- ;;
- android-linux)
- os=-linux-android
- basic_machine=`echo "$1" | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`-unknown
- ;;
- *)
- basic_machine=`echo "$1" | sed 's/-[^-]*$//'`
- if [ "$basic_machine" != "$1" ]
- then os=`echo "$1" | sed 's/.*-/-/'`
- else os=; fi
- ;;
-esac
+# Split fields of configuration type
+# shellcheck disable=SC2162
+IFS="-" read field1 field2 field3 field4 <<EOF
+$1
+EOF
-### Let's recognize common machines as not being operating systems so
-### that things like config.sub decstation-3100 work. We also
-### recognize some manufacturers as not being operating systems, so we
-### can provide default operating systems below.
-case $os in
- -sun*os*)
- # Prevent following clause from handling this invalid input.
- ;;
- -dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \
- -att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \
- -unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \
- -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\
- -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \
- -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \
- -apple | -axis | -knuth | -cray | -microblaze*)
- os=
- basic_machine=$1
- ;;
- -bluegene*)
- os=-cnk
- ;;
- -sim | -cisco | -oki | -wec | -winbond)
- os=
- basic_machine=$1
- ;;
- -scout)
- ;;
- -wrs)
- os=-vxworks
- basic_machine=$1
- ;;
- -chorusos*)
- os=-chorusos
- basic_machine=$1
- ;;
- -chorusrdb)
- os=-chorusrdb
- basic_machine=$1
- ;;
- -hiux*)
- os=-hiuxwe2
- ;;
- -sco6)
- os=-sco5v6
- basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'`
- ;;
- -sco5)
- os=-sco3.2v5
- basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'`
- ;;
- -sco4)
- os=-sco3.2v4
- basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'`
- ;;
- -sco3.2.[4-9]*)
- os=`echo $os | sed -e 's/sco3.2./sco3.2v/'`
- basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'`
- ;;
- -sco3.2v[4-9]*)
- # Don't forget version if it is 3.2v4 or newer.
- basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'`
- ;;
- -sco5v6*)
- # Don't forget version if it is 3.2v4 or newer.
- basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'`
- ;;
- -sco*)
- os=-sco3.2v2
- basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'`
- ;;
- -udk*)
- basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'`
- ;;
- -isc)
- os=-isc2.2
- basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'`
- ;;
- -clix*)
- basic_machine=clipper-intergraph
- ;;
- -isc*)
- basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'`
- ;;
- -lynx*178)
- os=-lynxos178
- ;;
- -lynx*5)
- os=-lynxos5
+# Separate into logical components for further validation
+case $1 in
+ *-*-*-*-*)
+ echo Invalid configuration \`"$1"\': more than four components >&2
+ exit 1
;;
- -lynx*)
- os=-lynxos
+ *-*-*-*)
+ basic_machine=$field1-$field2
+ basic_os=$field3-$field4
;;
- -ptx*)
- basic_machine=`echo "$1" | sed -e 's/86-.*/86-sequent/'`
+ *-*-*)
+ # Ambiguous whether COMPANY is present, or skipped and KERNEL-OS is two
+ # parts
+ maybe_os=$field2-$field3
+ case $maybe_os in
+ nto-qnx* | linux-* | uclinux-uclibc* \
+ | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* \
+ | netbsd*-eabi* | kopensolaris*-gnu* | cloudabi*-eabi* \
+ | storm-chaos* | os2-emx* | rtmk-nova*)
+ basic_machine=$field1
+ basic_os=$maybe_os
+ ;;
+ android-linux)
+ basic_machine=$field1-unknown
+ basic_os=linux-android
+ ;;
+ *)
+ basic_machine=$field1-$field2
+ basic_os=$field3
+ ;;
+ esac
;;
- -psos*)
- os=-psos
+ *-*)
+ # A lone config we happen to match not fitting any pattern
+ case $field1-$field2 in
+ decstation-3100)
+ basic_machine=mips-dec
+ basic_os=
+ ;;
+ *-*)
+ # Second component is usually, but not always the OS
+ case $field2 in
+ # Prevent following clause from handling this valid os
+ sun*os*)
+ basic_machine=$field1
+ basic_os=$field2
+ ;;
+ # Manufacturers
+ dec* | mips* | sequent* | encore* | pc533* | sgi* | sony* \
+ | att* | 7300* | 3300* | delta* | motorola* | sun[234]* \
+ | unicom* | ibm* | next | hp | isi* | apollo | altos* \
+ | convergent* | ncr* | news | 32* | 3600* | 3100* \
+ | hitachi* | c[123]* | convex* | sun | crds | omron* | dg \
+ | ultra | tti* | harris | dolphin | highlevel | gould \
+ | cbm | ns | masscomp | apple | axis | knuth | cray \
+ | microblaze* | sim | cisco \
+ | oki | wec | wrs | winbond)
+ basic_machine=$field1-$field2
+ basic_os=
+ ;;
+ *)
+ basic_machine=$field1
+ basic_os=$field2
+ ;;
+ esac
+ ;;
+ esac
;;
- -mint | -mint[0-9]*)
- basic_machine=m68k-atari
- os=-mint
+ *)
+ # Convert single-component short-hands not valid as part of
+ # multi-component configurations.
+ case $field1 in
+ 386bsd)
+ basic_machine=i386-pc
+ basic_os=bsd
+ ;;
+ a29khif)
+ basic_machine=a29k-amd
+ basic_os=udi
+ ;;
+ adobe68k)
+ basic_machine=m68010-adobe
+ basic_os=scout
+ ;;
+ alliant)
+ basic_machine=fx80-alliant
+ basic_os=
+ ;;
+ altos | altos3068)
+ basic_machine=m68k-altos
+ basic_os=
+ ;;
+ am29k)
+ basic_machine=a29k-none
+ basic_os=bsd
+ ;;
+ amdahl)
+ basic_machine=580-amdahl
+ basic_os=sysv
+ ;;
+ amiga)
+ basic_machine=m68k-unknown
+ basic_os=
+ ;;
+ amigaos | amigados)
+ basic_machine=m68k-unknown
+ basic_os=amigaos
+ ;;
+ amigaunix | amix)
+ basic_machine=m68k-unknown
+ basic_os=sysv4
+ ;;
+ apollo68)
+ basic_machine=m68k-apollo
+ basic_os=sysv
+ ;;
+ apollo68bsd)
+ basic_machine=m68k-apollo
+ basic_os=bsd
+ ;;
+ aros)
+ basic_machine=i386-pc
+ basic_os=aros
+ ;;
+ aux)
+ basic_machine=m68k-apple
+ basic_os=aux
+ ;;
+ balance)
+ basic_machine=ns32k-sequent
+ basic_os=dynix
+ ;;
+ blackfin)
+ basic_machine=bfin-unknown
+ basic_os=linux
+ ;;
+ cegcc)
+ basic_machine=arm-unknown
+ basic_os=cegcc
+ ;;
+ convex-c1)
+ basic_machine=c1-convex
+ basic_os=bsd
+ ;;
+ convex-c2)
+ basic_machine=c2-convex
+ basic_os=bsd
+ ;;
+ convex-c32)
+ basic_machine=c32-convex
+ basic_os=bsd
+ ;;
+ convex-c34)
+ basic_machine=c34-convex
+ basic_os=bsd
+ ;;
+ convex-c38)
+ basic_machine=c38-convex
+ basic_os=bsd
+ ;;
+ cray)
+ basic_machine=j90-cray
+ basic_os=unicos
+ ;;
+ crds | unos)
+ basic_machine=m68k-crds
+ basic_os=
+ ;;
+ da30)
+ basic_machine=m68k-da30
+ basic_os=
+ ;;
+ decstation | pmax | pmin | dec3100 | decstatn)
+ basic_machine=mips-dec
+ basic_os=
+ ;;
+ delta88)
+ basic_machine=m88k-motorola
+ basic_os=sysv3
+ ;;
+ dicos)
+ basic_machine=i686-pc
+ basic_os=dicos
+ ;;
+ djgpp)
+ basic_machine=i586-pc
+ basic_os=msdosdjgpp
+ ;;
+ ebmon29k)
+ basic_machine=a29k-amd
+ basic_os=ebmon
+ ;;
+ es1800 | OSE68k | ose68k | ose | OSE)
+ basic_machine=m68k-ericsson
+ basic_os=ose
+ ;;
+ gmicro)
+ basic_machine=tron-gmicro
+ basic_os=sysv
+ ;;
+ go32)
+ basic_machine=i386-pc
+ basic_os=go32
+ ;;
+ h8300hms)
+ basic_machine=h8300-hitachi
+ basic_os=hms
+ ;;
+ h8300xray)
+ basic_machine=h8300-hitachi
+ basic_os=xray
+ ;;
+ h8500hms)
+ basic_machine=h8500-hitachi
+ basic_os=hms
+ ;;
+ harris)
+ basic_machine=m88k-harris
+ basic_os=sysv3
+ ;;
+ hp300 | hp300hpux)
+ basic_machine=m68k-hp
+ basic_os=hpux
+ ;;
+ hp300bsd)
+ basic_machine=m68k-hp
+ basic_os=bsd
+ ;;
+ hppaosf)
+ basic_machine=hppa1.1-hp
+ basic_os=osf
+ ;;
+ hppro)
+ basic_machine=hppa1.1-hp
+ basic_os=proelf
+ ;;
+ i386mach)
+ basic_machine=i386-mach
+ basic_os=mach
+ ;;
+ isi68 | isi)
+ basic_machine=m68k-isi
+ basic_os=sysv
+ ;;
+ m68knommu)
+ basic_machine=m68k-unknown
+ basic_os=linux
+ ;;
+ magnum | m3230)
+ basic_machine=mips-mips
+ basic_os=sysv
+ ;;
+ merlin)
+ basic_machine=ns32k-utek
+ basic_os=sysv
+ ;;
+ mingw64)
+ basic_machine=x86_64-pc
+ basic_os=mingw64
+ ;;
+ mingw32)
+ basic_machine=i686-pc
+ basic_os=mingw32
+ ;;
+ mingw32ce)
+ basic_machine=arm-unknown
+ basic_os=mingw32ce
+ ;;
+ monitor)
+ basic_machine=m68k-rom68k
+ basic_os=coff
+ ;;
+ morphos)
+ basic_machine=powerpc-unknown
+ basic_os=morphos
+ ;;
+ moxiebox)
+ basic_machine=moxie-unknown
+ basic_os=moxiebox
+ ;;
+ msdos)
+ basic_machine=i386-pc
+ basic_os=msdos
+ ;;
+ msys)
+ basic_machine=i686-pc
+ basic_os=msys
+ ;;
+ mvs)
+ basic_machine=i370-ibm
+ basic_os=mvs
+ ;;
+ nacl)
+ basic_machine=le32-unknown
+ basic_os=nacl
+ ;;
+ ncr3000)
+ basic_machine=i486-ncr
+ basic_os=sysv4
+ ;;
+ netbsd386)
+ basic_machine=i386-pc
+ basic_os=netbsd
+ ;;
+ netwinder)
+ basic_machine=armv4l-rebel
+ basic_os=linux
+ ;;
+ news | news700 | news800 | news900)
+ basic_machine=m68k-sony
+ basic_os=newsos
+ ;;
+ news1000)
+ basic_machine=m68030-sony
+ basic_os=newsos
+ ;;
+ necv70)
+ basic_machine=v70-nec
+ basic_os=sysv
+ ;;
+ nh3000)
+ basic_machine=m68k-harris
+ basic_os=cxux
+ ;;
+ nh[45]000)
+ basic_machine=m88k-harris
+ basic_os=cxux
+ ;;
+ nindy960)
+ basic_machine=i960-intel
+ basic_os=nindy
+ ;;
+ mon960)
+ basic_machine=i960-intel
+ basic_os=mon960
+ ;;
+ nonstopux)
+ basic_machine=mips-compaq
+ basic_os=nonstopux
+ ;;
+ os400)
+ basic_machine=powerpc-ibm
+ basic_os=os400
+ ;;
+ OSE68000 | ose68000)
+ basic_machine=m68000-ericsson
+ basic_os=ose
+ ;;
+ os68k)
+ basic_machine=m68k-none
+ basic_os=os68k
+ ;;
+ paragon)
+ basic_machine=i860-intel
+ basic_os=osf
+ ;;
+ parisc)
+ basic_machine=hppa-unknown
+ basic_os=linux
+ ;;
+ psp)
+ basic_machine=mipsallegrexel-sony
+ basic_os=psp
+ ;;
+ pw32)
+ basic_machine=i586-unknown
+ basic_os=pw32
+ ;;
+ rdos | rdos64)
+ basic_machine=x86_64-pc
+ basic_os=rdos
+ ;;
+ rdos32)
+ basic_machine=i386-pc
+ basic_os=rdos
+ ;;
+ rom68k)
+ basic_machine=m68k-rom68k
+ basic_os=coff
+ ;;
+ sa29200)
+ basic_machine=a29k-amd
+ basic_os=udi
+ ;;
+ sei)
+ basic_machine=mips-sei
+ basic_os=seiux
+ ;;
+ sequent)
+ basic_machine=i386-sequent
+ basic_os=
+ ;;
+ sps7)
+ basic_machine=m68k-bull
+ basic_os=sysv2
+ ;;
+ st2000)
+ basic_machine=m68k-tandem
+ basic_os=
+ ;;
+ stratus)
+ basic_machine=i860-stratus
+ basic_os=sysv4
+ ;;
+ sun2)
+ basic_machine=m68000-sun
+ basic_os=
+ ;;
+ sun2os3)
+ basic_machine=m68000-sun
+ basic_os=sunos3
+ ;;
+ sun2os4)
+ basic_machine=m68000-sun
+ basic_os=sunos4
+ ;;
+ sun3)
+ basic_machine=m68k-sun
+ basic_os=
+ ;;
+ sun3os3)
+ basic_machine=m68k-sun
+ basic_os=sunos3
+ ;;
+ sun3os4)
+ basic_machine=m68k-sun
+ basic_os=sunos4
+ ;;
+ sun4)
+ basic_machine=sparc-sun
+ basic_os=
+ ;;
+ sun4os3)
+ basic_machine=sparc-sun
+ basic_os=sunos3
+ ;;
+ sun4os4)
+ basic_machine=sparc-sun
+ basic_os=sunos4
+ ;;
+ sun4sol2)
+ basic_machine=sparc-sun
+ basic_os=solaris2
+ ;;
+ sun386 | sun386i | roadrunner)
+ basic_machine=i386-sun
+ basic_os=
+ ;;
+ sv1)
+ basic_machine=sv1-cray
+ basic_os=unicos
+ ;;
+ symmetry)
+ basic_machine=i386-sequent
+ basic_os=dynix
+ ;;
+ t3e)
+ basic_machine=alphaev5-cray
+ basic_os=unicos
+ ;;
+ t90)
+ basic_machine=t90-cray
+ basic_os=unicos
+ ;;
+ toad1)
+ basic_machine=pdp10-xkl
+ basic_os=tops20
+ ;;
+ tpf)
+ basic_machine=s390x-ibm
+ basic_os=tpf
+ ;;
+ udi29k)
+ basic_machine=a29k-amd
+ basic_os=udi
+ ;;
+ ultra3)
+ basic_machine=a29k-nyu
+ basic_os=sym1
+ ;;
+ v810 | necv810)
+ basic_machine=v810-nec
+ basic_os=none
+ ;;
+ vaxv)
+ basic_machine=vax-dec
+ basic_os=sysv
+ ;;
+ vms)
+ basic_machine=vax-dec
+ basic_os=vms
+ ;;
+ vsta)
+ basic_machine=i386-pc
+ basic_os=vsta
+ ;;
+ vxworks960)
+ basic_machine=i960-wrs
+ basic_os=vxworks
+ ;;
+ vxworks68)
+ basic_machine=m68k-wrs
+ basic_os=vxworks
+ ;;
+ vxworks29k)
+ basic_machine=a29k-wrs
+ basic_os=vxworks
+ ;;
+ xbox)
+ basic_machine=i686-pc
+ basic_os=mingw32
+ ;;
+ ymp)
+ basic_machine=ymp-cray
+ basic_os=unicos
+ ;;
+ *)
+ basic_machine=$1
+ basic_os=
+ ;;
+ esac
;;
esac
-# Decode aliases for certain CPU-COMPANY combinations.
+# Decode 1-component or ad-hoc basic machines
case $basic_machine in
- # Recognize the basic CPU types without company name.
- # Some are omitted here because they have special meanings below.
- 1750a | 580 \
- | a29k \
- | aarch64 | aarch64_be \
- | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \
- | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \
- | am33_2.0 \
- | arc | arceb \
- | arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv7[arm] \
- | avr | avr32 \
- | ba \
- | be32 | be64 \
- | bfin \
- | c4x | c8051 | clipper \
- | d10v | d30v | dlx | dsp16xx \
- | e2k | epiphany \
- | fido | fr30 | frv | ft32 \
- | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \
- | hexagon \
- | i370 | i860 | i960 | ia16 | ia64 \
- | ip2k | iq2000 \
- | k1om \
- | le32 | le64 \
- | lm32 \
- | m32c | m32r | m32rle | m68000 | m68k | m88k \
- | maxq | mb | microblaze | microblazeel | mcore | mep | metag \
- | mips | mipsbe | mipseb | mipsel | mipsle \
- | mips16 \
- | mips64 | mips64el \
- | mips64octeon | mips64octeonel \
- | mips64orion | mips64orionel \
- | mips64r5900 | mips64r5900el \
- | mips64vr | mips64vrel \
- | mips64vr4100 | mips64vr4100el \
- | mips64vr4300 | mips64vr4300el \
- | mips64vr5000 | mips64vr5000el \
- | mips64vr5900 | mips64vr5900el \
- | mipsisa32 | mipsisa32el \
- | mipsisa32r2 | mipsisa32r2el \
- | mipsisa32r6 | mipsisa32r6el \
- | mipsisa64 | mipsisa64el \
- | mipsisa64r2 | mipsisa64r2el \
- | mipsisa64r6 | mipsisa64r6el \
- | mipsisa64sb1 | mipsisa64sb1el \
- | mipsisa64sr71k | mipsisa64sr71kel \
- | mipsr5900 | mipsr5900el \
- | mipstx39 | mipstx39el \
- | mn10200 | mn10300 \
- | moxie \
- | mt \
- | msp430 \
- | nds32 | nds32le | nds32be \
- | nios | nios2 | nios2eb | nios2el \
- | ns16k | ns32k \
- | open8 | or1k | or1knd | or32 \
- | pdp10 | pj | pjl \
- | powerpc | powerpc64 | powerpc64le | powerpcle \
- | pru \
- | pyramid \
- | riscv32 | riscv64 \
- | rl78 | rx \
- | score \
- | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[234]eb | sheb | shbe | shle | sh[1234]le | sh3ele \
- | sh64 | sh64le \
- | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \
- | sparcv8 | sparcv9 | sparcv9b | sparcv9v \
- | spu \
- | tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \
- | ubicom32 \
- | v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \
- | visium \
- | wasm32 \
- | x86 | xc16x | xstormy16 | xtensa \
- | z8k | z80)
- basic_machine=$basic_machine-unknown
- ;;
- c54x)
- basic_machine=tic54x-unknown
- ;;
- c55x)
- basic_machine=tic55x-unknown
- ;;
- c6x)
- basic_machine=tic6x-unknown
- ;;
- leon|leon[3-9])
- basic_machine=sparc-$basic_machine
- ;;
- m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | nvptx | picochip)
- basic_machine=$basic_machine-unknown
- os=-none
+ # Here we handle the default manufacturer of certain CPU types. It is in
+ # some cases the only manufacturer, in others, it is the most popular.
+ w89k)
+ cpu=hppa1.1
+ vendor=winbond
;;
- m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65)
+ op50n)
+ cpu=hppa1.1
+ vendor=oki
;;
- ms1)
- basic_machine=mt-unknown
+ op60c)
+ cpu=hppa1.1
+ vendor=oki
;;
-
- strongarm | thumb | xscale)
- basic_machine=arm-unknown
+ ibm*)
+ cpu=i370
+ vendor=ibm
;;
- xgate)
- basic_machine=$basic_machine-unknown
- os=-none
+ orion105)
+ cpu=clipper
+ vendor=highlevel
;;
- xscaleeb)
- basic_machine=armeb-unknown
+ mac | mpw | mac-mpw)
+ cpu=m68k
+ vendor=apple
;;
-
- xscaleel)
- basic_machine=armel-unknown
+ pmac | pmac-mpw)
+ cpu=powerpc
+ vendor=apple
;;
- # We use `pc' rather than `unknown'
- # because (1) that's what they normally are, and
- # (2) the word "unknown" tends to confuse beginning users.
- i*86 | x86_64)
- basic_machine=$basic_machine-pc
- ;;
- # Object if more than one company name word.
- *-*-*)
- echo Invalid configuration \`"$1"\': machine \`"$basic_machine"\' not recognized 1>&2
- exit 1
- ;;
- # Recognize the basic CPU types with company name.
- 580-* \
- | a29k-* \
- | aarch64-* | aarch64_be-* \
- | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \
- | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \
- | alphapca5[67]-* | alpha64pca5[67]-* | arc-* | arceb-* \
- | arm-* | armbe-* | armle-* | armeb-* | armv*-* \
- | avr-* | avr32-* \
- | ba-* \
- | be32-* | be64-* \
- | bfin-* | bs2000-* \
- | c[123]* | c30-* | [cjt]90-* | c4x-* \
- | c8051-* | clipper-* | craynv-* | cydra-* \
- | d10v-* | d30v-* | dlx-* \
- | e2k-* | elxsi-* \
- | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \
- | h8300-* | h8500-* \
- | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \
- | hexagon-* \
- | i*86-* | i860-* | i960-* | ia16-* | ia64-* \
- | ip2k-* | iq2000-* \
- | k1om-* \
- | le32-* | le64-* \
- | lm32-* \
- | m32c-* | m32r-* | m32rle-* \
- | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \
- | m88110-* | m88k-* | maxq-* | mcore-* | metag-* \
- | microblaze-* | microblazeel-* \
- | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \
- | mips16-* \
- | mips64-* | mips64el-* \
- | mips64octeon-* | mips64octeonel-* \
- | mips64orion-* | mips64orionel-* \
- | mips64r5900-* | mips64r5900el-* \
- | mips64vr-* | mips64vrel-* \
- | mips64vr4100-* | mips64vr4100el-* \
- | mips64vr4300-* | mips64vr4300el-* \
- | mips64vr5000-* | mips64vr5000el-* \
- | mips64vr5900-* | mips64vr5900el-* \
- | mipsisa32-* | mipsisa32el-* \
- | mipsisa32r2-* | mipsisa32r2el-* \
- | mipsisa32r6-* | mipsisa32r6el-* \
- | mipsisa64-* | mipsisa64el-* \
- | mipsisa64r2-* | mipsisa64r2el-* \
- | mipsisa64r6-* | mipsisa64r6el-* \
- | mipsisa64sb1-* | mipsisa64sb1el-* \
- | mipsisa64sr71k-* | mipsisa64sr71kel-* \
- | mipsr5900-* | mipsr5900el-* \
- | mipstx39-* | mipstx39el-* \
- | mmix-* \
- | mt-* \
- | msp430-* \
- | nds32-* | nds32le-* | nds32be-* \
- | nios-* | nios2-* | nios2eb-* | nios2el-* \
- | none-* | np1-* | ns16k-* | ns32k-* \
- | open8-* \
- | or1k*-* \
- | orion-* \
- | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \
- | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \
- | pru-* \
- | pyramid-* \
- | riscv32-* | riscv64-* \
- | rl78-* | romp-* | rs6000-* | rx-* \
- | sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \
- | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \
- | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \
- | sparclite-* \
- | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx*-* \
- | tahoe-* \
- | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \
- | tile*-* \
- | tron-* \
- | ubicom32-* \
- | v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \
- | vax-* \
- | visium-* \
- | wasm32-* \
- | we32k-* \
- | x86-* | x86_64-* | xc16x-* | xps100-* \
- | xstormy16-* | xtensa*-* \
- | ymp-* \
- | z8k-* | z80-*)
- ;;
- # Recognize the basic CPU types without company name, with glob match.
- xtensa*)
- basic_machine=$basic_machine-unknown
- ;;
# Recognize the various machine names and aliases which stand
# for a CPU type and a company and sometimes even an OS.
- 386bsd)
- basic_machine=i386-pc
- os=-bsd
- ;;
3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc)
- basic_machine=m68000-att
+ cpu=m68000
+ vendor=att
;;
3b*)
- basic_machine=we32k-att
- ;;
- a29khif)
- basic_machine=a29k-amd
- os=-udi
- ;;
- abacus)
- basic_machine=abacus-unknown
- ;;
- adobe68k)
- basic_machine=m68010-adobe
- os=-scout
- ;;
- alliant | fx80)
- basic_machine=fx80-alliant
- ;;
- altos | altos3068)
- basic_machine=m68k-altos
- ;;
- am29k)
- basic_machine=a29k-none
- os=-bsd
- ;;
- amd64)
- basic_machine=x86_64-pc
- ;;
- amd64-*)
- basic_machine=x86_64-`echo "$basic_machine" | sed 's/^[^-]*-//'`
- ;;
- amdahl)
- basic_machine=580-amdahl
- os=-sysv
- ;;
- amiga | amiga-*)
- basic_machine=m68k-unknown
- ;;
- amigaos | amigados)
- basic_machine=m68k-unknown
- os=-amigaos
- ;;
- amigaunix | amix)
- basic_machine=m68k-unknown
- os=-sysv4
- ;;
- apollo68)
- basic_machine=m68k-apollo
- os=-sysv
- ;;
- apollo68bsd)
- basic_machine=m68k-apollo
- os=-bsd
- ;;
- aros)
- basic_machine=i386-pc
- os=-aros
- ;;
- asmjs)
- basic_machine=asmjs-unknown
- ;;
- aux)
- basic_machine=m68k-apple
- os=-aux
- ;;
- balance)
- basic_machine=ns32k-sequent
- os=-dynix
- ;;
- blackfin)
- basic_machine=bfin-unknown
- os=-linux
- ;;
- blackfin-*)
- basic_machine=bfin-`echo "$basic_machine" | sed 's/^[^-]*-//'`
- os=-linux
+ cpu=we32k
+ vendor=att
;;
bluegene*)
- basic_machine=powerpc-ibm
- os=-cnk
- ;;
- c54x-*)
- basic_machine=tic54x-`echo "$basic_machine" | sed 's/^[^-]*-//'`
- ;;
- c55x-*)
- basic_machine=tic55x-`echo "$basic_machine" | sed 's/^[^-]*-//'`
- ;;
- c6x-*)
- basic_machine=tic6x-`echo "$basic_machine" | sed 's/^[^-]*-//'`
- ;;
- c90)
- basic_machine=c90-cray
- os=-unicos
- ;;
- cegcc)
- basic_machine=arm-unknown
- os=-cegcc
- ;;
- convex-c1)
- basic_machine=c1-convex
- os=-bsd
- ;;
- convex-c2)
- basic_machine=c2-convex
- os=-bsd
- ;;
- convex-c32)
- basic_machine=c32-convex
- os=-bsd
- ;;
- convex-c34)
- basic_machine=c34-convex
- os=-bsd
- ;;
- convex-c38)
- basic_machine=c38-convex
- os=-bsd
- ;;
- cray | j90)
- basic_machine=j90-cray
- os=-unicos
- ;;
- craynv)
- basic_machine=craynv-cray
- os=-unicosmp
- ;;
- cr16 | cr16-*)
- basic_machine=cr16-unknown
- os=-elf
- ;;
- crds | unos)
- basic_machine=m68k-crds
- ;;
- crisv32 | crisv32-* | etraxfs*)
- basic_machine=crisv32-axis
- ;;
- cris | cris-* | etrax*)
- basic_machine=cris-axis
- ;;
- crx)
- basic_machine=crx-unknown
- os=-elf
- ;;
- da30 | da30-*)
- basic_machine=m68k-da30
- ;;
- decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn)
- basic_machine=mips-dec
+ cpu=powerpc
+ vendor=ibm
+ basic_os=cnk
;;
decsystem10* | dec10*)
- basic_machine=pdp10-dec
- os=-tops10
+ cpu=pdp10
+ vendor=dec
+ basic_os=tops10
;;
decsystem20* | dec20*)
- basic_machine=pdp10-dec
- os=-tops20
+ cpu=pdp10
+ vendor=dec
+ basic_os=tops20
;;
delta | 3300 | motorola-3300 | motorola-delta \
| 3300-motorola | delta-motorola)
- basic_machine=m68k-motorola
- ;;
- delta88)
- basic_machine=m88k-motorola
- os=-sysv3
- ;;
- dicos)
- basic_machine=i686-pc
- os=-dicos
- ;;
- djgpp)
- basic_machine=i586-pc
- os=-msdosdjgpp
- ;;
- dpx20 | dpx20-*)
- basic_machine=rs6000-bull
- os=-bosx
+ cpu=m68k
+ vendor=motorola
;;
dpx2*)
- basic_machine=m68k-bull
- os=-sysv3
- ;;
- e500v[12])
- basic_machine=powerpc-unknown
- os=$os"spe"
- ;;
- e500v[12]-*)
- basic_machine=powerpc-`echo "$basic_machine" | sed 's/^[^-]*-//'`
- os=$os"spe"
- ;;
- ebmon29k)
- basic_machine=a29k-amd
- os=-ebmon
- ;;
- elxsi)
- basic_machine=elxsi-elxsi
- os=-bsd
+ cpu=m68k
+ vendor=bull
+ basic_os=sysv3
;;
encore | umax | mmax)
- basic_machine=ns32k-encore
+ cpu=ns32k
+ vendor=encore
;;
- es1800 | OSE68k | ose68k | ose | OSE)
- basic_machine=m68k-ericsson
- os=-ose
+ elxsi)
+ cpu=elxsi
+ vendor=elxsi
+ basic_os=${basic_os:-bsd}
;;
fx2800)
- basic_machine=i860-alliant
+ cpu=i860
+ vendor=alliant
;;
genix)
- basic_machine=ns32k-ns
- ;;
- gmicro)
- basic_machine=tron-gmicro
- os=-sysv
- ;;
- go32)
- basic_machine=i386-pc
- os=-go32
+ cpu=ns32k
+ vendor=ns
;;
h3050r* | hiux*)
- basic_machine=hppa1.1-hitachi
- os=-hiuxwe2
- ;;
- h8300hms)
- basic_machine=h8300-hitachi
- os=-hms
- ;;
- h8300xray)
- basic_machine=h8300-hitachi
- os=-xray
- ;;
- h8500hms)
- basic_machine=h8500-hitachi
- os=-hms
- ;;
- harris)
- basic_machine=m88k-harris
- os=-sysv3
- ;;
- hp300-*)
- basic_machine=m68k-hp
- ;;
- hp300bsd)
- basic_machine=m68k-hp
- os=-bsd
- ;;
- hp300hpux)
- basic_machine=m68k-hp
- os=-hpux
+ cpu=hppa1.1
+ vendor=hitachi
+ basic_os=hiuxwe2
;;
hp3k9[0-9][0-9] | hp9[0-9][0-9])
- basic_machine=hppa1.0-hp
+ cpu=hppa1.0
+ vendor=hp
;;
hp9k2[0-9][0-9] | hp9k31[0-9])
- basic_machine=m68000-hp
+ cpu=m68000
+ vendor=hp
;;
hp9k3[2-9][0-9])
- basic_machine=m68k-hp
+ cpu=m68k
+ vendor=hp
;;
hp9k6[0-9][0-9] | hp6[0-9][0-9])
- basic_machine=hppa1.0-hp
+ cpu=hppa1.0
+ vendor=hp
;;
hp9k7[0-79][0-9] | hp7[0-79][0-9])
- basic_machine=hppa1.1-hp
+ cpu=hppa1.1
+ vendor=hp
;;
hp9k78[0-9] | hp78[0-9])
# FIXME: really hppa2.0-hp
- basic_machine=hppa1.1-hp
+ cpu=hppa1.1
+ vendor=hp
;;
hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893)
# FIXME: really hppa2.0-hp
- basic_machine=hppa1.1-hp
+ cpu=hppa1.1
+ vendor=hp
;;
hp9k8[0-9][13679] | hp8[0-9][13679])
- basic_machine=hppa1.1-hp
+ cpu=hppa1.1
+ vendor=hp
;;
hp9k8[0-9][0-9] | hp8[0-9][0-9])
- basic_machine=hppa1.0-hp
- ;;
- hppaosf)
- basic_machine=hppa1.1-hp
- os=-osf
- ;;
- hppro)
- basic_machine=hppa1.1-hp
- os=-proelf
- ;;
- i370-ibm* | ibm*)
- basic_machine=i370-ibm
+ cpu=hppa1.0
+ vendor=hp
;;
i*86v32)
- basic_machine=`echo "$1" | sed -e 's/86.*/86-pc/'`
- os=-sysv32
+ cpu=`echo "$1" | sed -e 's/86.*/86/'`
+ vendor=pc
+ basic_os=sysv32
;;
i*86v4*)
- basic_machine=`echo "$1" | sed -e 's/86.*/86-pc/'`
- os=-sysv4
+ cpu=`echo "$1" | sed -e 's/86.*/86/'`
+ vendor=pc
+ basic_os=sysv4
;;
i*86v)
- basic_machine=`echo "$1" | sed -e 's/86.*/86-pc/'`
- os=-sysv
+ cpu=`echo "$1" | sed -e 's/86.*/86/'`
+ vendor=pc
+ basic_os=sysv
;;
i*86sol2)
- basic_machine=`echo "$1" | sed -e 's/86.*/86-pc/'`
- os=-solaris2
- ;;
- i386mach)
- basic_machine=i386-mach
- os=-mach
+ cpu=`echo "$1" | sed -e 's/86.*/86/'`
+ vendor=pc
+ basic_os=solaris2
;;
- vsta)
- basic_machine=i386-unknown
- os=-vsta
+ j90 | j90-cray)
+ cpu=j90
+ vendor=cray
+ basic_os=${basic_os:-unicos}
;;
iris | iris4d)
- basic_machine=mips-sgi
- case $os in
- -irix*)
+ cpu=mips
+ vendor=sgi
+ case $basic_os in
+ irix*)
;;
*)
- os=-irix4
+ basic_os=irix4
;;
esac
;;
- isi68 | isi)
- basic_machine=m68k-isi
- os=-sysv
- ;;
- leon-*|leon[3-9]-*)
- basic_machine=sparc-`echo "$basic_machine" | sed 's/-.*//'`
- ;;
- m68knommu)
- basic_machine=m68k-unknown
- os=-linux
- ;;
- m68knommu-*)
- basic_machine=m68k-`echo "$basic_machine" | sed 's/^[^-]*-//'`
- os=-linux
- ;;
- magnum | m3230)
- basic_machine=mips-mips
- os=-sysv
- ;;
- merlin)
- basic_machine=ns32k-utek
- os=-sysv
- ;;
- microblaze*)
- basic_machine=microblaze-xilinx
- ;;
- mingw64)
- basic_machine=x86_64-pc
- os=-mingw64
- ;;
- mingw32)
- basic_machine=i686-pc
- os=-mingw32
- ;;
- mingw32ce)
- basic_machine=arm-unknown
- os=-mingw32ce
- ;;
miniframe)
- basic_machine=m68000-convergent
- ;;
- *mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*)
- basic_machine=m68k-atari
- os=-mint
- ;;
- mips3*-*)
- basic_machine=`echo "$basic_machine" | sed -e 's/mips3/mips64/'`
- ;;
- mips3*)
- basic_machine=`echo "$basic_machine" | sed -e 's/mips3/mips64/'`-unknown
- ;;
- monitor)
- basic_machine=m68k-rom68k
- os=-coff
- ;;
- morphos)
- basic_machine=powerpc-unknown
- os=-morphos
- ;;
- moxiebox)
- basic_machine=moxie-unknown
- os=-moxiebox
+ cpu=m68000
+ vendor=convergent
;;
- msdos)
- basic_machine=i386-pc
- os=-msdos
- ;;
- ms1-*)
- basic_machine=`echo "$basic_machine" | sed -e 's/ms1-/mt-/'`
- ;;
- msys)
- basic_machine=i686-pc
- os=-msys
- ;;
- mvs)
- basic_machine=i370-ibm
- os=-mvs
- ;;
- nacl)
- basic_machine=le32-unknown
- os=-nacl
- ;;
- ncr3000)
- basic_machine=i486-ncr
- os=-sysv4
- ;;
- netbsd386)
- basic_machine=i386-unknown
- os=-netbsd
- ;;
- netwinder)
- basic_machine=armv4l-rebel
- os=-linux
- ;;
- news | news700 | news800 | news900)
- basic_machine=m68k-sony
- os=-newsos
- ;;
- news1000)
- basic_machine=m68030-sony
- os=-newsos
+ *mint | mint[0-9]* | *MiNT | *MiNT[0-9]*)
+ cpu=m68k
+ vendor=atari
+ basic_os=mint
;;
news-3600 | risc-news)
- basic_machine=mips-sony
- os=-newsos
- ;;
- necv70)
- basic_machine=v70-nec
- os=-sysv
+ cpu=mips
+ vendor=sony
+ basic_os=newsos
;;
next | m*-next)
- basic_machine=m68k-next
- case $os in
- -nextstep* )
+ cpu=m68k
+ vendor=next
+ case $basic_os in
+ openstep*)
+ ;;
+ nextstep*)
;;
- -ns2*)
- os=-nextstep2
+ ns2*)
+ basic_os=nextstep2
;;
*)
- os=-nextstep3
+ basic_os=nextstep3
;;
esac
;;
- nh3000)
- basic_machine=m68k-harris
- os=-cxux
- ;;
- nh[45]000)
- basic_machine=m88k-harris
- os=-cxux
- ;;
- nindy960)
- basic_machine=i960-intel
- os=-nindy
- ;;
- mon960)
- basic_machine=i960-intel
- os=-mon960
- ;;
- nonstopux)
- basic_machine=mips-compaq
- os=-nonstopux
- ;;
np1)
- basic_machine=np1-gould
- ;;
- neo-tandem)
- basic_machine=neo-tandem
- ;;
- nse-tandem)
- basic_machine=nse-tandem
- ;;
- nsr-tandem)
- basic_machine=nsr-tandem
- ;;
- nsv-tandem)
- basic_machine=nsv-tandem
- ;;
- nsx-tandem)
- basic_machine=nsx-tandem
+ cpu=np1
+ vendor=gould
;;
op50n-* | op60c-*)
- basic_machine=hppa1.1-oki
- os=-proelf
- ;;
- openrisc | openrisc-*)
- basic_machine=or32-unknown
- ;;
- os400)
- basic_machine=powerpc-ibm
- os=-os400
- ;;
- OSE68000 | ose68000)
- basic_machine=m68000-ericsson
- os=-ose
- ;;
- os68k)
- basic_machine=m68k-none
- os=-os68k
+ cpu=hppa1.1
+ vendor=oki
+ basic_os=proelf
;;
pa-hitachi)
- basic_machine=hppa1.1-hitachi
- os=-hiuxwe2
- ;;
- paragon)
- basic_machine=i860-intel
- os=-osf
- ;;
- parisc)
- basic_machine=hppa-unknown
- os=-linux
- ;;
- parisc-*)
- basic_machine=hppa-`echo "$basic_machine" | sed 's/^[^-]*-//'`
- os=-linux
+ cpu=hppa1.1
+ vendor=hitachi
+ basic_os=hiuxwe2
;;
pbd)
- basic_machine=sparc-tti
+ cpu=sparc
+ vendor=tti
;;
pbb)
- basic_machine=m68k-tti
- ;;
- pc532 | pc532-*)
- basic_machine=ns32k-pc532
- ;;
- pc98)
- basic_machine=i386-pc
+ cpu=m68k
+ vendor=tti
;;
- pc98-*)
- basic_machine=i386-`echo "$basic_machine" | sed 's/^[^-]*-//'`
- ;;
- pentium | p5 | k5 | k6 | nexgen | viac3)
- basic_machine=i586-pc
- ;;
- pentiumpro | p6 | 6x86 | athlon | athlon_*)
- basic_machine=i686-pc
- ;;
- pentiumii | pentium2 | pentiumiii | pentium3)
- basic_machine=i686-pc
- ;;
- pentium4)
- basic_machine=i786-pc
- ;;
- pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*)
- basic_machine=i586-`echo "$basic_machine" | sed 's/^[^-]*-//'`
- ;;
- pentiumpro-* | p6-* | 6x86-* | athlon-*)
- basic_machine=i686-`echo "$basic_machine" | sed 's/^[^-]*-//'`
- ;;
- pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*)
- basic_machine=i686-`echo "$basic_machine" | sed 's/^[^-]*-//'`
- ;;
- pentium4-*)
- basic_machine=i786-`echo "$basic_machine" | sed 's/^[^-]*-//'`
+ pc532)
+ cpu=ns32k
+ vendor=pc532
;;
pn)
- basic_machine=pn-gould
- ;;
- power) basic_machine=power-ibm
- ;;
- ppc | ppcbe) basic_machine=powerpc-unknown
+ cpu=pn
+ vendor=gould
;;
- ppc-* | ppcbe-*)
- basic_machine=powerpc-`echo "$basic_machine" | sed 's/^[^-]*-//'`
- ;;
- ppcle | powerpclittle)
- basic_machine=powerpcle-unknown
- ;;
- ppcle-* | powerpclittle-*)
- basic_machine=powerpcle-`echo "$basic_machine" | sed 's/^[^-]*-//'`
+ power)
+ cpu=power
+ vendor=ibm
;;
- ppc64) basic_machine=powerpc64-unknown
+ ps2)
+ cpu=i386
+ vendor=ibm
;;
- ppc64-*) basic_machine=powerpc64-`echo "$basic_machine" | sed 's/^[^-]*-//'`
+ rm[46]00)
+ cpu=mips
+ vendor=siemens
;;
- ppc64le | powerpc64little)
- basic_machine=powerpc64le-unknown
+ rtpc | rtpc-*)
+ cpu=romp
+ vendor=ibm
;;
- ppc64le-* | powerpc64little-*)
- basic_machine=powerpc64le-`echo "$basic_machine" | sed 's/^[^-]*-//'`
+ sde)
+ cpu=mipsisa32
+ vendor=sde
+ basic_os=${basic_os:-elf}
;;
- ps2)
- basic_machine=i386-ibm
+ simso-wrs)
+ cpu=sparclite
+ vendor=wrs
+ basic_os=vxworks
;;
- pw32)
- basic_machine=i586-unknown
- os=-pw32
+ tower | tower-32)
+ cpu=m68k
+ vendor=ncr
;;
- rdos | rdos64)
- basic_machine=x86_64-pc
- os=-rdos
+ vpp*|vx|vx-*)
+ cpu=f301
+ vendor=fujitsu
;;
- rdos32)
- basic_machine=i386-pc
- os=-rdos
+ w65)
+ cpu=w65
+ vendor=wdc
;;
- rom68k)
- basic_machine=m68k-rom68k
- os=-coff
+ w89k-*)
+ cpu=hppa1.1
+ vendor=winbond
+ basic_os=proelf
;;
- rm[46]00)
- basic_machine=mips-siemens
+ none)
+ cpu=none
+ vendor=none
;;
- rtpc | rtpc-*)
- basic_machine=romp-ibm
+ leon|leon[3-9])
+ cpu=sparc
+ vendor=$basic_machine
;;
- s390 | s390-*)
- basic_machine=s390-ibm
+ leon-*|leon[3-9]-*)
+ cpu=sparc
+ vendor=`echo "$basic_machine" | sed 's/-.*//'`
;;
- s390x | s390x-*)
- basic_machine=s390x-ibm
+
+ *-*)
+ # shellcheck disable=SC2162
+ IFS="-" read cpu vendor <<EOF
+$basic_machine
+EOF
;;
- sa29200)
- basic_machine=a29k-amd
- os=-udi
+ # We use `pc' rather than `unknown'
+ # because (1) that's what they normally are, and
+ # (2) the word "unknown" tends to confuse beginning users.
+ i*86 | x86_64)
+ cpu=$basic_machine
+ vendor=pc
;;
- sb1)
- basic_machine=mipsisa64sb1-unknown
+ # These rules are duplicated from below for sake of the special case above;
+ # i.e. things that normalized to x86 arches should also default to "pc"
+ pc98)
+ cpu=i386
+ vendor=pc
;;
- sb1el)
- basic_machine=mipsisa64sb1el-unknown
+ x64 | amd64)
+ cpu=x86_64
+ vendor=pc
;;
- sde)
- basic_machine=mipsisa32-sde
- os=-elf
+ # Recognize the basic CPU types without company name.
+ *)
+ cpu=$basic_machine
+ vendor=unknown
;;
- sei)
- basic_machine=mips-sei
- os=-seiux
+esac
+
+unset -v basic_machine
+
+# Decode basic machines in the full and proper CPU-Company form.
+case $cpu-$vendor in
+ # Here we handle the default manufacturer of certain CPU types in canonical form. It is in
+ # some cases the only manufacturer, in others, it is the most popular.
+ craynv-unknown)
+ vendor=cray
+ basic_os=${basic_os:-unicosmp}
;;
- sequent)
- basic_machine=i386-sequent
+ c90-unknown | c90-cray)
+ vendor=cray
+ basic_os=${Basic_os:-unicos}
;;
- sh5el)
- basic_machine=sh5le-unknown
+ fx80-unknown)
+ vendor=alliant
;;
- simso-wrs)
- basic_machine=sparclite-wrs
- os=-vxworks
+ romp-unknown)
+ vendor=ibm
;;
- sps7)
- basic_machine=m68k-bull
- os=-sysv2
+ mmix-unknown)
+ vendor=knuth
;;
- spur)
- basic_machine=spur-unknown
+ microblaze-unknown | microblazeel-unknown)
+ vendor=xilinx
;;
- st2000)
- basic_machine=m68k-tandem
+ rs6000-unknown)
+ vendor=ibm
;;
- stratus)
- basic_machine=i860-stratus
- os=-sysv4
+ vax-unknown)
+ vendor=dec
;;
- strongarm-* | thumb-*)
- basic_machine=arm-`echo "$basic_machine" | sed 's/^[^-]*-//'`
+ pdp11-unknown)
+ vendor=dec
;;
- sun2)
- basic_machine=m68000-sun
+ we32k-unknown)
+ vendor=att
;;
- sun2os3)
- basic_machine=m68000-sun
- os=-sunos3
+ cydra-unknown)
+ vendor=cydrome
;;
- sun2os4)
- basic_machine=m68000-sun
- os=-sunos4
+ i370-ibm*)
+ vendor=ibm
;;
- sun3os3)
- basic_machine=m68k-sun
- os=-sunos3
+ orion-unknown)
+ vendor=highlevel
;;
- sun3os4)
- basic_machine=m68k-sun
- os=-sunos4
+ xps-unknown | xps100-unknown)
+ cpu=xps100
+ vendor=honeywell
;;
- sun4os3)
- basic_machine=sparc-sun
- os=-sunos3
+
+ # Here we normalize CPU types with a missing or matching vendor
+ dpx20-unknown | dpx20-bull)
+ cpu=rs6000
+ vendor=bull
+ basic_os=${basic_os:-bosx}
;;
- sun4os4)
- basic_machine=sparc-sun
- os=-sunos4
+
+ # Here we normalize CPU types irrespective of the vendor
+ amd64-*)
+ cpu=x86_64
;;
- sun4sol2)
- basic_machine=sparc-sun
- os=-solaris2
+ blackfin-*)
+ cpu=bfin
+ basic_os=linux
;;
- sun3 | sun3-*)
- basic_machine=m68k-sun
+ c54x-*)
+ cpu=tic54x
;;
- sun4)
- basic_machine=sparc-sun
+ c55x-*)
+ cpu=tic55x
;;
- sun386 | sun386i | roadrunner)
- basic_machine=i386-sun
+ c6x-*)
+ cpu=tic6x
;;
- sv1)
- basic_machine=sv1-cray
- os=-unicos
+ e500v[12]-*)
+ cpu=powerpc
+ basic_os=${basic_os}"spe"
;;
- symmetry)
- basic_machine=i386-sequent
- os=-dynix
+ mips3*-*)
+ cpu=mips64
;;
- t3e)
- basic_machine=alphaev5-cray
- os=-unicos
+ ms1-*)
+ cpu=mt
;;
- t90)
- basic_machine=t90-cray
- os=-unicos
+ m68knommu-*)
+ cpu=m68k
+ basic_os=linux
;;
- tile*)
- basic_machine=$basic_machine-unknown
- os=-linux-gnu
+ m9s12z-* | m68hcs12z-* | hcs12z-* | s12z-*)
+ cpu=s12z
;;
- tx39)
- basic_machine=mipstx39-unknown
+ openrisc-*)
+ cpu=or32
;;
- tx39el)
- basic_machine=mipstx39el-unknown
+ parisc-*)
+ cpu=hppa
+ basic_os=linux
;;
- toad1)
- basic_machine=pdp10-xkl
- os=-tops20
+ pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*)
+ cpu=i586
;;
- tower | tower-32)
- basic_machine=m68k-ncr
+ pentiumpro-* | p6-* | 6x86-* | athlon-* | athalon_*-*)
+ cpu=i686
;;
- tpf)
- basic_machine=s390x-ibm
- os=-tpf
+ pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*)
+ cpu=i686
;;
- udi29k)
- basic_machine=a29k-amd
- os=-udi
+ pentium4-*)
+ cpu=i786
;;
- ultra3)
- basic_machine=a29k-nyu
- os=-sym1
+ pc98-*)
+ cpu=i386
;;
- v810 | necv810)
- basic_machine=v810-nec
- os=-none
+ ppc-* | ppcbe-*)
+ cpu=powerpc
;;
- vaxv)
- basic_machine=vax-dec
- os=-sysv
+ ppcle-* | powerpclittle-*)
+ cpu=powerpcle
;;
- vms)
- basic_machine=vax-dec
- os=-vms
+ ppc64-*)
+ cpu=powerpc64
;;
- vpp*|vx|vx-*)
- basic_machine=f301-fujitsu
+ ppc64le-* | powerpc64little-*)
+ cpu=powerpc64le
;;
- vxworks960)
- basic_machine=i960-wrs
- os=-vxworks
+ sb1-*)
+ cpu=mipsisa64sb1
;;
- vxworks68)
- basic_machine=m68k-wrs
- os=-vxworks
+ sb1el-*)
+ cpu=mipsisa64sb1el
;;
- vxworks29k)
- basic_machine=a29k-wrs
- os=-vxworks
+ sh5e[lb]-*)
+ cpu=`echo "$cpu" | sed 's/^\(sh.\)e\(.\)$/\1\2e/'`
;;
- w65*)
- basic_machine=w65-wdc
- os=-none
+ spur-*)
+ cpu=spur
;;
- w89k-*)
- basic_machine=hppa1.1-winbond
- os=-proelf
+ strongarm-* | thumb-*)
+ cpu=arm
;;
- x64)
- basic_machine=x86_64-pc
+ tx39-*)
+ cpu=mipstx39
;;
- xbox)
- basic_machine=i686-pc
- os=-mingw32
+ tx39el-*)
+ cpu=mipstx39el
;;
- xps | xps100)
- basic_machine=xps100-honeywell
+ x64-*)
+ cpu=x86_64
;;
xscale-* | xscalee[bl]-*)
- basic_machine=`echo "$basic_machine" | sed 's/^xscale/arm/'`
- ;;
- ymp)
- basic_machine=ymp-cray
- os=-unicos
+ cpu=`echo "$cpu" | sed 's/^xscale/arm/'`
;;
- none)
- basic_machine=none-none
- os=-none
+ arm64-*)
+ cpu=aarch64
;;
-# Here we handle the default manufacturer of certain CPU types. It is in
-# some cases the only manufacturer, in others, it is the most popular.
- w89k)
- basic_machine=hppa1.1-winbond
- ;;
- op50n)
- basic_machine=hppa1.1-oki
- ;;
- op60c)
- basic_machine=hppa1.1-oki
- ;;
- romp)
- basic_machine=romp-ibm
+ # Recognize the canonical CPU Types that limit and/or modify the
+ # company names they are paired with.
+ cr16-*)
+ basic_os=${basic_os:-elf}
;;
- mmix)
- basic_machine=mmix-knuth
+ crisv32-* | etraxfs*-*)
+ cpu=crisv32
+ vendor=axis
;;
- rs6000)
- basic_machine=rs6000-ibm
+ cris-* | etrax*-*)
+ cpu=cris
+ vendor=axis
;;
- vax)
- basic_machine=vax-dec
+ crx-*)
+ basic_os=${basic_os:-elf}
;;
- pdp11)
- basic_machine=pdp11-dec
- ;;
- we32k)
- basic_machine=we32k-att
- ;;
- sh[1234] | sh[24]a | sh[24]aeb | sh[34]eb | sh[1234]le | sh[23]ele)
- basic_machine=sh-unknown
+ neo-tandem)
+ cpu=neo
+ vendor=tandem
;;
- cydra)
- basic_machine=cydra-cydrome
+ nse-tandem)
+ cpu=nse
+ vendor=tandem
;;
- orion)
- basic_machine=orion-highlevel
+ nsr-tandem)
+ cpu=nsr
+ vendor=tandem
;;
- orion105)
- basic_machine=clipper-highlevel
+ nsv-tandem)
+ cpu=nsv
+ vendor=tandem
;;
- mac | mpw | mac-mpw)
- basic_machine=m68k-apple
+ nsx-tandem)
+ cpu=nsx
+ vendor=tandem
;;
- pmac | pmac-mpw)
- basic_machine=powerpc-apple
+ mipsallegrexel-sony)
+ cpu=mipsallegrexel
+ vendor=sony
;;
- *-unknown)
- # Make sure to match an already-canonicalized machine name.
+ tile*-*)
+ basic_os=${basic_os:-linux-gnu}
;;
+
*)
- echo Invalid configuration \`"$1"\': machine \`"$basic_machine"\' not recognized 1>&2
- exit 1
+ # Recognize the canonical CPU types that are allowed with any
+ # company name.
+ case $cpu in
+ 1750a | 580 \
+ | a29k \
+ | aarch64 | aarch64_be \
+ | abacus \
+ | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] \
+ | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] \
+ | alphapca5[67] | alpha64pca5[67] \
+ | am33_2.0 \
+ | amdgcn \
+ | arc | arceb \
+ | arm | arm[lb]e | arme[lb] | armv* \
+ | avr | avr32 \
+ | asmjs \
+ | ba \
+ | be32 | be64 \
+ | bfin | bpf | bs2000 \
+ | c[123]* | c30 | [cjt]90 | c4x \
+ | c8051 | clipper | craynv | csky | cydra \
+ | d10v | d30v | dlx | dsp16xx \
+ | e2k | elxsi | epiphany \
+ | f30[01] | f700 | fido | fr30 | frv | ft32 | fx80 \
+ | h8300 | h8500 \
+ | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \
+ | hexagon \
+ | i370 | i*86 | i860 | i960 | ia16 | ia64 \
+ | ip2k | iq2000 \
+ | k1om \
+ | le32 | le64 \
+ | lm32 \
+ | m32c | m32r | m32rle \
+ | m5200 | m68000 | m680[012346]0 | m68360 | m683?2 | m68k \
+ | m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x \
+ | m88110 | m88k | maxq | mb | mcore | mep | metag \
+ | microblaze | microblazeel \
+ | mips | mipsbe | mipseb | mipsel | mipsle \
+ | mips16 \
+ | mips64 | mips64eb | mips64el \
+ | mips64octeon | mips64octeonel \
+ | mips64orion | mips64orionel \
+ | mips64r5900 | mips64r5900el \
+ | mips64vr | mips64vrel \
+ | mips64vr4100 | mips64vr4100el \
+ | mips64vr4300 | mips64vr4300el \
+ | mips64vr5000 | mips64vr5000el \
+ | mips64vr5900 | mips64vr5900el \
+ | mipsisa32 | mipsisa32el \
+ | mipsisa32r2 | mipsisa32r2el \
+ | mipsisa32r6 | mipsisa32r6el \
+ | mipsisa64 | mipsisa64el \
+ | mipsisa64r2 | mipsisa64r2el \
+ | mipsisa64r6 | mipsisa64r6el \
+ | mipsisa64sb1 | mipsisa64sb1el \
+ | mipsisa64sr71k | mipsisa64sr71kel \
+ | mipsr5900 | mipsr5900el \
+ | mipstx39 | mipstx39el \
+ | mmix \
+ | mn10200 | mn10300 \
+ | moxie \
+ | mt \
+ | msp430 \
+ | nds32 | nds32le | nds32be \
+ | nfp \
+ | nios | nios2 | nios2eb | nios2el \
+ | none | np1 | ns16k | ns32k | nvptx \
+ | open8 \
+ | or1k* \
+ | or32 \
+ | orion \
+ | picochip \
+ | pdp10 | pdp11 | pj | pjl | pn | power \
+ | powerpc | powerpc64 | powerpc64le | powerpcle | powerpcspe \
+ | pru \
+ | pyramid \
+ | riscv | riscv32 | riscv64 \
+ | rl78 | romp | rs6000 | rx \
+ | s390 | s390x \
+ | score \
+ | sh | shl \
+ | sh[1234] | sh[24]a | sh[24]ae[lb] | sh[23]e | she[lb] | sh[lb]e \
+ | sh[1234]e[lb] | sh[12345][lb]e | sh[23]ele | sh64 | sh64le \
+ | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet \
+ | sparclite \
+ | sparcv8 | sparcv9 | sparcv9b | sparcv9v | sv1 | sx* \
+ | spu \
+ | tahoe \
+ | tic30 | tic4x | tic54x | tic55x | tic6x | tic80 \
+ | tron \
+ | ubicom32 \
+ | v70 | v850 | v850e | v850e1 | v850es | v850e2 | v850e2v3 \
+ | vax \
+ | visium \
+ | w65 \
+ | wasm32 | wasm64 \
+ | we32k \
+ | x86 | x86_64 | xc16x | xgate | xps100 \
+ | xstormy16 | xtensa* \
+ | ymp \
+ | z8k | z80)
+ ;;
+
+ *)
+ echo Invalid configuration \`"$1"\': machine \`"$cpu-$vendor"\' not recognized 1>&2
+ exit 1
+ ;;
+ esac
;;
esac
# Here we canonicalize certain aliases for manufacturers.
-case $basic_machine in
- *-digital*)
- basic_machine=`echo "$basic_machine" | sed 's/digital.*/dec/'`
+case $vendor in
+ digital*)
+ vendor=dec
;;
- *-commodore*)
- basic_machine=`echo "$basic_machine" | sed 's/commodore.*/cbm/'`
+ commodore*)
+ vendor=cbm
;;
*)
;;
# Decode manufacturer-specific aliases for certain operating systems.
-if [ x"$os" != x"" ]
+if [ x$basic_os != x ]
then
+
+# First recognize some ad-hoc caes, or perhaps split kernel-os, or else just
+# set os.
+case $basic_os in
+ gnu/linux*)
+ kernel=linux
+ os=`echo $basic_os | sed -e 's|gnu/linux|gnu|'`
+ ;;
+ nto-qnx*)
+ kernel=nto
+ os=`echo $basic_os | sed -e 's|nto-qnx|qnx|'`
+ ;;
+ *-*)
+ # shellcheck disable=SC2162
+ IFS="-" read kernel os <<EOF
+$basic_os
+EOF
+ ;;
+ # Default OS when just kernel was specified
+ nto*)
+ kernel=nto
+ os=`echo $basic_os | sed -e 's|nto|qnx|'`
+ ;;
+ linux*)
+ kernel=linux
+ os=`echo $basic_os | sed -e 's|linux|gnu|'`
+ ;;
+ *)
+ kernel=
+ os=$basic_os
+ ;;
+esac
+
+# Now, normalize the OS (knowing we just have one component, it's not a kernel,
+# etc.)
case $os in
# First match some system type aliases that might get confused
# with valid system types.
- # -solaris* is a basic system type, with this one exception.
- -auroraux)
- os=-auroraux
+ # solaris* is a basic system type, with this one exception.
+ auroraux)
+ os=auroraux
;;
- -solaris1 | -solaris1.*)
- os=`echo $os | sed -e 's|solaris1|sunos4|'`
+ bluegene*)
+ os=cnk
;;
- -solaris)
- os=-solaris2
+ solaris1 | solaris1.*)
+ os=`echo $os | sed -e 's|solaris1|sunos4|'`
;;
- -unixware*)
- os=-sysv4.2uw
+ solaris)
+ os=solaris2
;;
- -gnu/linux*)
- os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'`
+ unixware*)
+ os=sysv4.2uw
;;
# es1800 is here to avoid being matched by es* (a different OS)
- -es1800*)
- os=-ose
+ es1800*)
+ os=ose
;;
- # Now accept the basic system types.
- # The portable systems comes first.
- # Each alternative MUST end in a * to match a version number.
- # -sysv* is not here because it comes later, after sysvr4.
- -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \
- | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\
- | -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \
- | -sym* | -kopensolaris* | -plan9* \
- | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \
- | -aos* | -aros* | -cloudabi* | -sortix* \
- | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \
- | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \
- | -hiux* | -knetbsd* | -mirbsd* | -netbsd* \
- | -bitrig* | -openbsd* | -solidbsd* | -libertybsd* \
- | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \
- | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \
- | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \
- | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \
- | -chorusos* | -chorusrdb* | -cegcc* | -glidix* \
- | -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \
- | -midipix* | -mingw32* | -mingw64* | -linux-gnu* | -linux-android* \
- | -linux-newlib* | -linux-musl* | -linux-uclibc* \
- | -uxpv* | -beos* | -mpeix* | -udk* | -moxiebox* \
- | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* \
- | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \
- | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \
- | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \
- | -morphos* | -superux* | -rtmk* | -windiss* \
- | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \
- | -skyos* | -haiku* | -rdos* | -toppers* | -drops* | -es* \
- | -onefs* | -tirtos* | -phoenix* | -fuchsia* | -redox* | -bme* \
- | -midnightbsd*)
- # Remember, each alternative MUST END IN *, to match a version number.
- ;;
- -qnx*)
- case $basic_machine in
- x86-* | i*86-*)
+ # Some version numbers need modification
+ chorusos*)
+ os=chorusos
+ ;;
+ isc)
+ os=isc2.2
+ ;;
+ sco6)
+ os=sco5v6
+ ;;
+ sco5)
+ os=sco3.2v5
+ ;;
+ sco4)
+ os=sco3.2v4
+ ;;
+ sco3.2.[4-9]*)
+ os=`echo $os | sed -e 's/sco3.2./sco3.2v/'`
+ ;;
+ sco*v* | scout)
+ # Don't match below
+ ;;
+ sco*)
+ os=sco3.2v2
+ ;;
+ psos*)
+ os=psos
+ ;;
+ qnx*)
+ case $cpu in
+ x86 | i*86)
;;
*)
- os=-nto$os
+ os=nto-$os
;;
esac
;;
- -nto-qnx*)
+ hiux*)
+ os=hiuxwe2
+ ;;
+ lynx*178)
+ os=lynxos178
;;
- -nto*)
- os=`echo $os | sed -e 's|nto|nto-qnx|'`
+ lynx*5)
+ os=lynxos5
;;
- -sim | -xray | -os68k* | -v88r* \
- | -windows* | -osx | -abug | -netware* | -os9* \
- | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*)
+ lynxos*)
+ # don't get caught up in next wildcard
;;
- -mac*)
+ lynx*)
+ os=lynxos
+ ;;
+ mac[0-9]*)
os=`echo "$os" | sed -e 's|mac|macos|'`
;;
- -linux-dietlibc)
- os=-linux-dietlibc
+ opened*)
+ os=openedition
;;
- -linux*)
- os=`echo $os | sed -e 's|linux|linux-gnu|'`
+ os400*)
+ os=os400
;;
- -sunos5*)
+ sunos5*)
os=`echo "$os" | sed -e 's|sunos5|solaris2|'`
;;
- -sunos6*)
+ sunos6*)
os=`echo "$os" | sed -e 's|sunos6|solaris3|'`
;;
- -opened*)
- os=-openedition
- ;;
- -os400*)
- os=-os400
- ;;
- -wince*)
- os=-wince
+ wince*)
+ os=wince
;;
- -utek*)
- os=-bsd
+ utek*)
+ os=bsd
;;
- -dynix*)
- os=-bsd
+ dynix*)
+ os=bsd
;;
- -acis*)
- os=-aos
+ acis*)
+ os=aos
;;
- -atheos*)
- os=-atheos
+ atheos*)
+ os=atheos
;;
- -syllable*)
- os=-syllable
+ syllable*)
+ os=syllable
;;
- -386bsd)
- os=-bsd
- ;;
- -ctix* | -uts*)
- os=-sysv
+ 386bsd)
+ os=bsd
;;
- -nova*)
- os=-rtmk-nova
+ ctix* | uts*)
+ os=sysv
;;
- -ns2)
- os=-nextstep2
+ nova*)
+ os=rtmk-nova
;;
- -nsk*)
- os=-nsk
+ ns2)
+ os=nextstep2
;;
# Preserve the version number of sinix5.
- -sinix5.*)
+ sinix5.*)
os=`echo $os | sed -e 's|sinix|sysv|'`
;;
- -sinix*)
- os=-sysv4
- ;;
- -tpf*)
- os=-tpf
- ;;
- -triton*)
- os=-sysv3
+ sinix*)
+ os=sysv4
;;
- -oss*)
- os=-sysv3
+ tpf*)
+ os=tpf
;;
- -svr4*)
- os=-sysv4
+ triton*)
+ os=sysv3
;;
- -svr3)
- os=-sysv3
+ oss*)
+ os=sysv3
;;
- -sysvr4)
- os=-sysv4
+ svr4*)
+ os=sysv4
;;
- # This must come after -sysvr4.
- -sysv*)
+ svr3)
+ os=sysv3
;;
- -ose*)
- os=-ose
+ sysvr4)
+ os=sysv4
;;
- -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*)
- os=-mint
+ ose*)
+ os=ose
;;
- -zvmoe)
- os=-zvmoe
+ *mint | mint[0-9]* | *MiNT | MiNT[0-9]*)
+ os=mint
;;
- -dicos*)
- os=-dicos
+ dicos*)
+ os=dicos
;;
- -pikeos*)
+ pikeos*)
# Until real need of OS specific support for
# particular features comes up, bare metal
# configurations are quite functional.
- case $basic_machine in
+ case $cpu in
arm*)
- os=-eabi
+ os=eabi
;;
*)
- os=-elf
+ os=elf
;;
esac
;;
- -nacl*)
- ;;
- -ios)
- ;;
- -none)
- ;;
*)
- # Get rid of the `-' at the beginning of $os.
- os=`echo $os | sed 's/[^-]*-//'`
- echo Invalid configuration \`"$1"\': system \`"$os"\' not recognized 1>&2
- exit 1
+ # No normalization, but not necessarily accepted, that comes below.
;;
esac
+
else
# Here we handle the default operating systems that come with various machines.
# will signal an error saying that MANUFACTURER isn't an operating
# system, and we'll never get to this point.
-case $basic_machine in
+kernel=
+case $cpu-$vendor in
score-*)
- os=-elf
+ os=elf
;;
spu-*)
- os=-elf
+ os=elf
;;
*-acorn)
- os=-riscix1.2
+ os=riscix1.2
;;
arm*-rebel)
- os=-linux
+ kernel=linux
+ os=gnu
;;
arm*-semi)
- os=-aout
+ os=aout
;;
c4x-* | tic4x-*)
- os=-coff
+ os=coff
;;
c8051-*)
- os=-elf
+ os=elf
+ ;;
+ clipper-intergraph)
+ os=clix
;;
hexagon-*)
- os=-elf
+ os=elf
;;
tic54x-*)
- os=-coff
+ os=coff
;;
tic55x-*)
- os=-coff
+ os=coff
;;
tic6x-*)
- os=-coff
+ os=coff
;;
# This must come before the *-dec entry.
pdp10-*)
- os=-tops20
+ os=tops20
;;
pdp11-*)
- os=-none
+ os=none
;;
*-dec | vax-*)
- os=-ultrix4.2
+ os=ultrix4.2
;;
m68*-apollo)
- os=-domain
+ os=domain
;;
i386-sun)
- os=-sunos4.0.2
+ os=sunos4.0.2
;;
m68000-sun)
- os=-sunos3
+ os=sunos3
;;
m68*-cisco)
- os=-aout
+ os=aout
;;
mep-*)
- os=-elf
+ os=elf
;;
mips*-cisco)
- os=-elf
+ os=elf
;;
mips*-*)
- os=-elf
+ os=elf
;;
or32-*)
- os=-coff
+ os=coff
;;
*-tti) # must be before sparc entry or we get the wrong os.
- os=-sysv3
+ os=sysv3
;;
sparc-* | *-sun)
- os=-sunos4.1.1
+ os=sunos4.1.1
;;
pru-*)
- os=-elf
+ os=elf
;;
*-be)
- os=-beos
+ os=beos
;;
*-ibm)
- os=-aix
+ os=aix
;;
*-knuth)
- os=-mmixware
+ os=mmixware
;;
*-wec)
- os=-proelf
+ os=proelf
;;
*-winbond)
- os=-proelf
+ os=proelf
;;
*-oki)
- os=-proelf
+ os=proelf
;;
*-hp)
- os=-hpux
+ os=hpux
;;
*-hitachi)
- os=-hiux
+ os=hiux
;;
i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent)
- os=-sysv
+ os=sysv
;;
*-cbm)
- os=-amigaos
+ os=amigaos
;;
*-dg)
- os=-dgux
+ os=dgux
;;
*-dolphin)
- os=-sysv3
+ os=sysv3
;;
m68k-ccur)
- os=-rtu
+ os=rtu
;;
m88k-omron*)
- os=-luna
+ os=luna
;;
*-next)
- os=-nextstep
+ os=nextstep
;;
*-sequent)
- os=-ptx
+ os=ptx
;;
*-crds)
- os=-unos
+ os=unos
;;
*-ns)
- os=-genix
+ os=genix
;;
i370-*)
- os=-mvs
+ os=mvs
;;
*-gould)
- os=-sysv
+ os=sysv
;;
*-highlevel)
- os=-bsd
+ os=bsd
;;
*-encore)
- os=-bsd
+ os=bsd
;;
*-sgi)
- os=-irix
+ os=irix
;;
*-siemens)
- os=-sysv4
+ os=sysv4
;;
*-masscomp)
- os=-rtu
+ os=rtu
;;
f30[01]-fujitsu | f700-fujitsu)
- os=-uxpv
+ os=uxpv
;;
*-rom68k)
- os=-coff
+ os=coff
;;
*-*bug)
- os=-coff
+ os=coff
;;
*-apple)
- os=-macos
+ os=macos
;;
*-atari*)
- os=-mint
+ os=mint
+ ;;
+ *-wrs)
+ os=vxworks
;;
*)
- os=-none
+ os=none
;;
esac
+
fi
+# Now, validate our (potentially fixed-up) OS.
+case $os in
+ # Sometimes we do "kernel-abi", so those need to count as OSes.
+ musl* | newlib* | uclibc*)
+ ;;
+ # Likewise for "kernel-libc"
+ eabi | eabihf | gnueabi | gnueabihf)
+ ;;
+ # Now accept the basic system types.
+ # The portable systems comes first.
+ # Each alternative MUST end in a * to match a version number.
+ gnu* | android* | bsd* | mach* | minix* | genix* | ultrix* | irix* \
+ | *vms* | esix* | aix* | cnk* | sunos | sunos[34]* \
+ | hpux* | unos* | osf* | luna* | dgux* | auroraux* | solaris* \
+ | sym* | plan9* | psp* | sim* | xray* | os68k* | v88r* \
+ | hiux* | abug | nacl* | netware* | windows* \
+ | os9* | macos* | osx* | ios* \
+ | mpw* | magic* | mmixware* | mon960* | lnews* \
+ | amigaos* | amigados* | msdos* | newsos* | unicos* | aof* \
+ | aos* | aros* | cloudabi* | sortix* | twizzler* \
+ | nindy* | vxsim* | vxworks* | ebmon* | hms* | mvs* \
+ | clix* | riscos* | uniplus* | iris* | isc* | rtu* | xenix* \
+ | mirbsd* | netbsd* | dicos* | openedition* | ose* \
+ | bitrig* | openbsd* | solidbsd* | libertybsd* | os108* \
+ | ekkobsd* | freebsd* | riscix* | lynxos* | os400* \
+ | bosx* | nextstep* | cxux* | aout* | elf* | oabi* \
+ | ptx* | coff* | ecoff* | winnt* | domain* | vsta* \
+ | udi* | lites* | ieee* | go32* | aux* | hcos* \
+ | chorusrdb* | cegcc* | glidix* \
+ | cygwin* | msys* | pe* | moss* | proelf* | rtems* \
+ | midipix* | mingw32* | mingw64* | mint* \
+ | uxpv* | beos* | mpeix* | udk* | moxiebox* \
+ | interix* | uwin* | mks* | rhapsody* | darwin* \
+ | openstep* | oskit* | conix* | pw32* | nonstopux* \
+ | storm-chaos* | tops10* | tenex* | tops20* | its* \
+ | os2* | vos* | palmos* | uclinux* | nucleus* | morphos* \
+ | scout* | superux* | sysv* | rtmk* | tpf* | windiss* \
+ | powermax* | dnix* | nx6 | nx7 | sei* | dragonfly* \
+ | skyos* | haiku* | rdos* | toppers* | drops* | es* \
+ | onefs* | tirtos* | phoenix* | fuchsia* | redox* | bme* \
+ | midnightbsd* | amdhsa* | unleashed* | emscripten* | wasi* \
+ | nsk* | powerunix* | genode* | zvmoe* )
+ ;;
+ # This one is extra strict with allowed versions
+ sco3.2v2 | sco3.2v[4-9]* | sco5v6*)
+ # Don't forget version if it is 3.2v4 or newer.
+ ;;
+ none)
+ ;;
+ *)
+ echo Invalid configuration \`"$1"\': OS \`"$os"\' not recognized 1>&2
+ exit 1
+ ;;
+esac
+
+# As a final step for OS-related things, validate the OS-kernel combination
+# (given a valid OS), if there is a kernel.
+case $kernel-$os in
+ linux-gnu* | linux-dietlibc* | linux-android* | linux-newlib* | linux-musl* | linux-uclibc* )
+ ;;
+ -dietlibc* | -newlib* | -musl* | -uclibc* )
+ # These are just libc implementations, not actual OSes, and thus
+ # require a kernel.
+ echo "Invalid configuration \`$1': libc \`$os' needs explicit kernel." 1>&2
+ exit 1
+ ;;
+ kfreebsd*-gnu* | kopensolaris*-gnu*)
+ ;;
+ nto-qnx*)
+ ;;
+ *-eabi* | *-gnueabi*)
+ ;;
+ -*)
+ # Blank kernel with real OS is always fine.
+ ;;
+ *-*)
+ echo "Invalid configuration \`$1': Kernel \`$kernel' not known to work with OS \`$os'." 1>&2
+ exit 1
+ ;;
+esac
+
# Here we handle the case where we know the os, and the CPU type, but not the
# manufacturer. We pick the logical manufacturer.
-vendor=unknown
-case $basic_machine in
- *-unknown)
- case $os in
- -riscix*)
+case $vendor in
+ unknown)
+ case $cpu-$os in
+ *-riscix*)
vendor=acorn
;;
- -sunos*)
+ *-sunos*)
vendor=sun
;;
- -cnk*|-aix*)
+ *-cnk* | *-aix*)
vendor=ibm
;;
- -beos*)
+ *-beos*)
vendor=be
;;
- -hpux*)
+ *-hpux*)
vendor=hp
;;
- -mpeix*)
+ *-mpeix*)
vendor=hp
;;
- -hiux*)
+ *-hiux*)
vendor=hitachi
;;
- -unos*)
+ *-unos*)
vendor=crds
;;
- -dgux*)
+ *-dgux*)
vendor=dg
;;
- -luna*)
+ *-luna*)
vendor=omron
;;
- -genix*)
+ *-genix*)
vendor=ns
;;
- -mvs* | -opened*)
+ *-clix*)
+ vendor=intergraph
+ ;;
+ *-mvs* | *-opened*)
+ vendor=ibm
+ ;;
+ *-os400*)
vendor=ibm
;;
- -os400*)
+ s390-* | s390x-*)
vendor=ibm
;;
- -ptx*)
+ *-ptx*)
vendor=sequent
;;
- -tpf*)
+ *-tpf*)
vendor=ibm
;;
- -vxsim* | -vxworks* | -windiss*)
+ *-vxsim* | *-vxworks* | *-windiss*)
vendor=wrs
;;
- -aux*)
+ *-aux*)
vendor=apple
;;
- -hms*)
+ *-hms*)
vendor=hitachi
;;
- -mpw* | -macos*)
+ *-mpw* | *-macos*)
vendor=apple
;;
- -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*)
+ *-*mint | *-mint[0-9]* | *-*MiNT | *-MiNT[0-9]*)
vendor=atari
;;
- -vos*)
+ *-vos*)
vendor=stratus
;;
esac
- basic_machine=`echo "$basic_machine" | sed "s/unknown/$vendor/"`
;;
esac
-echo "$basic_machine$os"
+echo "$cpu-$vendor-${kernel:+$kernel-}$os"
exit
# Local variables:
-# eval: (add-hook 'write-file-functions 'time-stamp)
+# eval: (add-hook 'before-save-hook 'time-stamp)
# time-stamp-start: "timestamp='"
# time-stamp-format: "%:y-%02m-%02d"
# time-stamp-end: "'"
| Lvar id ->
begin try Ident.find_same id env with Not_found -> RHS_nonrec end
| Lfunction{params} as funct ->
- RHS_function (1 + Ident.Set.cardinal(free_variables funct),
+ RHS_function (2 + Ident.Set.cardinal(free_variables funct),
List.length params)
| Llet (Strict, _k, id, Lprim (Pduprecord (kind, size), _, _), body)
when check_recordwith_updates id body ->
let fv =
Ident.Set.elements (free_variables (Lletrec(bindings, lambda_unit))) in
(* See Instruct(CLOSUREREC) in interp.c *)
- let blocksize = List.length bindings * 2 - 1 + List.length fv in
- let offsets = List.mapi (fun i (id, _e) -> (id, i * 2)) bindings in
+ let blocksize = List.length bindings * 3 - 1 + List.length fv in
+ let offsets = List.mapi (fun i (id, _e) -> (id, i * 3)) bindings in
let env = List.fold_right (fun (id, offset) env ->
Ident.add id (RHS_infix { blocksize; offset }) env) offsets env in
size_of_lambda env body
comp_expr env arg sz (add_const_unit cont)
| Lprim(Pdirapply, [func;arg], loc)
| Lprim(Prevapply, [arg;func], loc) ->
- let exp = Lapply{ap_should_be_tailcall=false;
- ap_loc=loc;
- ap_func=func;
- ap_args=[arg];
- ap_inlined=Default_inline;
- ap_specialised=Default_specialise} in
+ let exp = Lapply{
+ ap_loc=loc;
+ ap_func=func;
+ ap_args=[arg];
+ ap_tailcall=Default_tailcall;
+ ap_inlined=Default_inline;
+ ap_specialised=Default_specialise;
+ } in
comp_expr env exp sz cont
| Lprim(Pnot, [arg], _) ->
let newcont =
| id :: rem -> Ident.add id pos (positions (pos + delta) delta rem) in
let env =
{ ce_stack = positions arity (-1) tc.params;
- ce_heap = positions (2 * (tc.num_defs - tc.rec_pos) - 1) 1 tc.free_vars;
- ce_rec = positions (-2 * tc.rec_pos) 2 tc.rec_vars } in
+ ce_heap = positions (3 * (tc.num_defs - tc.rec_pos) - 1) 1 tc.free_vars;
+ ce_rec = positions (-3 * tc.rec_pos) 3 tc.rec_vars } in
let cont =
comp_block env tc.body arity (Kreturn arity :: cont) in
if arity > 1 then
| Custom_runtime
| File_exists of filepath
| Cannot_open_dll of filepath
- | Required_module_unavailable of modname
+ | Required_module_unavailable of modname * modname
| Camlheader of string * filepath
exception Error of error
(* First pass: determine which units are needed *)
-let missing_globals = ref Ident.Set.empty
+let missing_globals = ref Ident.Map.empty
let is_required (rel, _pos) =
match rel with
Reloc_setglobal id ->
- Ident.Set.mem id !missing_globals
+ Ident.Map.mem id !missing_globals
| _ -> false
let add_required compunit =
let add id =
- missing_globals := Ident.Set.add id !missing_globals
+ missing_globals := Ident.Map.add id compunit.cu_name !missing_globals
in
List.iter add (Symtable.required_globals compunit.cu_reloc);
List.iter add compunit.cu_required_globals
let remove_required (rel, _pos) =
match rel with
Reloc_setglobal id ->
- missing_globals := Ident.Set.remove id !missing_globals
+ missing_globals := Ident.Map.remove id !missing_globals
| _ -> ()
let scan_file obj_name tolink =
begin try
let source = List.assoc cu.cu_name !implementations_defined in
Location.prerr_warning (Location.in_file file_name)
- (Warnings.Multiple_definition(cu.cu_name,
+ (Warnings.Module_linked_twice(cu.cu_name,
Location.show_filename file_name,
Location.show_filename source))
with Not_found -> ()
(fun () ->
(* The bytecode *)
output_string outchan "\
-#define CAML_INTERNALS\
+#define CAML_INTERNALS\n\
+#define CAMLDLLIMPORT\
\n\
\n#ifdef __cplusplus\
\nextern \"C\" {\
else "-lcamlrun" ^ !Clflags.runtime_variant in
let debug_prefix_map =
if Config.c_has_debug_prefix_map && not !Clflags.keep_camlprimc_file then
- [Printf.sprintf "-fdebug-prefix-map=%s=camlprim.c" prim_name]
+ let flag =
+ [Printf.sprintf "-fdebug-prefix-map=%s=camlprim.c" prim_name]
+ in
+ if Ccomp.linker_is_flexlink then
+ "-link" :: flag
+ else
+ flag
else
[] in
let exitcode =
in
let tolink = List.fold_right scan_file objfiles [] in
let missing_modules =
- Ident.Set.filter (fun id -> not (Ident.is_predef id)) !missing_globals
+ Ident.Map.filter (fun id _ -> not (Ident.is_predef id)) !missing_globals
in
begin
- match Ident.Set.elements missing_modules with
+ match Ident.Map.bindings missing_modules with
| [] -> ()
- | id :: _ -> raise (Error (Required_module_unavailable (Ident.name id)))
+ | (id, cu_name) :: _ ->
+ raise (Error (Required_module_unavailable (Ident.name id, cu_name)))
end;
Clflags.ccobjs := !Clflags.ccobjs @ !lib_ccobjs; (* put user's libs last *)
Clflags.all_ccopts := !lib_ccopts @ !Clflags.all_ccopts;
| Cannot_open_dll file ->
fprintf ppf "Error on dynamically loaded library: %a"
Location.print_filename file
- | Required_module_unavailable s ->
- fprintf ppf "Required module `%s' is unavailable" s
+ | Required_module_unavailable (s, m) ->
+ fprintf ppf "Module `%s' is unavailable (required by `%s')" s m
| Camlheader (msg, header) ->
fprintf ppf "System error while copying file %s: %s" header msg
lib_ccobjs := [];
lib_ccopts := [];
lib_dllibs := [];
- missing_globals := Ident.Set.empty;
+ missing_globals := Ident.Map.empty;
Consistbl.clear crc_interfaces;
implementations_defined := [];
debug_info := [];
| Custom_runtime
| File_exists of filepath
| Cannot_open_dll of filepath
- | Required_module_unavailable of modname
+ | Required_module_unavailable of modname * modname
| Camlheader of string * filepath
exception Error of error
(* Current search path for DLLs *)
let search_path = ref ([] : string list)
+type opened_dll =
+ | Checking of Binutils.t
+ | Execution of dll_handle
+
+let dll_close = function
+ | Checking _ -> ()
+ | Execution dll -> dll_close dll
+
(* DLLs currently opened *)
-let opened_dlls = ref ([] : dll_handle list)
+let opened_dlls = ref ([] : opened_dll list)
(* File names for those DLLs *)
let names_of_opened_dlls = ref ([] : string list)
else fullname
with Not_found -> name in
if not (List.mem fullname !names_of_opened_dlls) then begin
- try
- let dll = dll_open mode fullname in
- names_of_opened_dlls := fullname :: !names_of_opened_dlls;
- opened_dlls := dll :: !opened_dlls
- with Failure msg ->
- failwith (fullname ^ ": " ^ msg)
+ let dll =
+ match mode with
+ | For_checking ->
+ begin match Binutils.read fullname with
+ | Ok t -> Checking t
+ | Error err ->
+ failwith (fullname ^ ": " ^ Binutils.error_to_string err)
+ end
+ | For_execution ->
+ begin match dll_open mode fullname with
+ | dll ->
+ Execution dll
+ | exception Failure msg ->
+ failwith (fullname ^ ": " ^ msg)
+ end
+ in
+ names_of_opened_dlls := fullname :: !names_of_opened_dlls;
+ opened_dlls := dll :: !opened_dlls
end
let open_dlls mode names =
opened_dlls := [];
names_of_opened_dlls := []
-(* Find a primitive in the currently opened DLLs.
- Raise [Not_found] if not found. *)
+(* Find a primitive in the currently opened DLLs. *)
+
+type primitive_address =
+ | Prim_loaded of dll_address
+ | Prim_exists
let find_primitive prim_name =
let rec find seen = function
[] ->
- raise Not_found
- | dll :: rem ->
+ None
+ | Execution dll as curr :: rem ->
let addr = dll_sym dll prim_name in
- if addr == Obj.magic () then find (dll :: seen) rem else begin
- if seen <> [] then opened_dlls := dll :: List.rev_append seen rem;
- addr
- end in
+ if addr == Obj.magic () then find (curr :: seen) rem else begin
+ if seen <> [] then opened_dlls := curr :: List.rev_append seen rem;
+ Some (Prim_loaded addr)
+ end
+ | Checking t as curr :: rem ->
+ if Binutils.defines_symbol t prim_name then
+ Some Prim_exists
+ else
+ find (curr :: seen) rem
+ in
find [] !opened_dlls
(* If linking in core (dynlink or toplevel), synchronize the VM
ld_library_path_contents() @
split_dll_path dllpath @
ld_conf_contents();
- opened_dlls := Array.to_list (get_current_dlls());
+ opened_dlls :=
+ List.map (fun dll -> Execution dll)
+ (Array.to_list (get_current_dlls()));
names_of_opened_dlls := [];
linking_in_core := true
(* The abstract type representing C function pointers *)
type dll_address
+type primitive_address =
+ | Prim_loaded of dll_address (* Primitive found in a DLL opened
+ "for execution" *)
+ | Prim_exists (* Primitive found in a DLL opened "for checking" *)
+
(* Find a primitive in the currently opened DLLs and return its address.
- Raise [Not_found] if not found. *)
-val find_primitive: string -> dll_address
+ Return [None] if the primitive is not found. *)
+val find_primitive: string -> primitive_address option
(* If linking in core (dynlink or toplevel), synchronize the VM
table of primitive with the linker's table of primitive
let const_as_int = function
| Const_base(Const_int i) -> i
| Const_base(Const_char c) -> Char.code c
- | Const_pointer i -> i
| _ -> raise AsInt
let is_immed i = immed_min <= i && i <= immed_max
let org = !out_position in
List.iter (out_label_with_orig org) lbls
| Koffsetclosure ofs ->
- if ofs = -2 || ofs = 0 || ofs = 2
- then out (opOFFSETCLOSURE0 + ofs / 2)
+ if ofs = -3 || ofs = 0 || ofs = 3
+ then out (opOFFSETCLOSURE0 + ofs / 3)
else (out opOFFSETCLOSURE; out_int ofs)
| Kgetglobal q -> out opGETGLOBAL; slot_for_getglobal q
| Ksetglobal q -> out opSETGLOBAL; slot_for_setglobal q
else (out opCONSTINT; out_int i)
| Const_base(Const_char c) ->
out opCONSTINT; out_int (Char.code c)
- | Const_pointer i ->
- if i >= 0 && i <= 3
- then out (opCONST0 + i)
- else (out opCONSTINT; out_int i)
| Const_block(t, []) ->
if t = 0 then out opATOM0 else (out opATOM; out_int t)
| _ ->
else (out opPUSHENVACC; out_int n);
emit c
| Kpush :: Koffsetclosure ofs :: c ->
- if ofs = -2 || ofs = 0 || ofs = 2
- then out(opPUSHOFFSETCLOSURE0 + ofs / 2)
+ if ofs = -3 || ofs = 0 || ofs = 3
+ then out(opPUSHOFFSETCLOSURE0 + ofs / 3)
else (out opPUSHOFFSETCLOSURE; out_int ofs);
emit c
| Kpush :: Kgetglobal id :: Kgetfield n :: c ->
else (out opPUSHCONSTINT; out_int i)
| Const_base(Const_char c) ->
out opPUSHCONSTINT; out_int(Char.code c)
- | Const_pointer i ->
- if i >= 0 && i <= 3
- then out (opPUSHCONST0 + i)
- else (out opPUSHCONSTINT; out_int i)
| Const_block(t, []) ->
if t = 0 then out opPUSHATOM0 else (out opPUSHATOM; out_int t)
| _ ->
= "caml_reify_bytecode"
external release_bytecode : bytecode -> unit
= "caml_static_release_bytecode"
-external invoke_traced_function : Obj.t -> Obj.t -> Obj.t -> Obj.t
+external invoke_traced_function : Obj.raw_data -> Obj.t -> Obj.t -> Obj.t
= "caml_invoke_traced_function"
external get_section_table : unit -> (string * Obj.t) list
= "caml_get_section_table"
= "caml_reify_bytecode"
external release_bytecode : bytecode -> unit
= "caml_static_release_bytecode"
-external invoke_traced_function : Obj.t -> Obj.t -> Obj.t -> Obj.t
+external invoke_traced_function : Obj.raw_data -> Obj.t -> Obj.t -> Obj.t
= "caml_invoke_traced_function"
external get_section_table : unit -> (string * Obj.t) list
= "caml_get_section_table"
then
PrimMap.enter c_prim_table name
else begin
- let symb =
- try Dll.find_primitive name
- with Not_found -> raise(Error(Unavailable_primitive name)) in
- let num = PrimMap.enter c_prim_table name in
- Dll.synchronize_primitive num symb;
- num
+ match Dll.find_primitive name with
+ | None -> raise(Error(Unavailable_primitive name))
+ | Some Prim_exists ->
+ PrimMap.enter c_prim_table name
+ | Some (Prim_loaded symb) ->
+ let num = PrimMap.enter c_prim_table name in
+ Dll.synchronize_primitive num symb;
+ num
end
let require_primitive name =
| Const_base(Const_int32 i) -> Obj.repr i
| Const_base(Const_int64 i) -> Obj.repr i
| Const_base(Const_nativeint i) -> Obj.repr i
- | Const_pointer i -> Obj.repr i
| Const_immstring s -> Obj.repr s
| Const_block(tag, fields) ->
let block = Obj.new_block tag (List.length fields) in
UTILS=utils/config.cmo utils/build_path_prefix_map.cmo utils/misc.cmo \
utils/identifiable.cmo utils/numbers.cmo utils/arg_helper.cmo \
- utils/clflags.cmo utils/profile.cmo utils/load_path.cmo \
+ utils/clflags.cmo utils/profile.cmo utils/local_store.cmo \
+ utils/load_path.cmo \
utils/terminfo.cmo utils/ccomp.cmo utils/warnings.cmo \
utils/consistbl.cmo utils/strongly_connected_components.cmo \
utils/targetint.cmo utils/int_replace_polymorphic_compare.cmo \
- utils/domainstate.cmo
+ utils/domainstate.cmo utils/binutils.cmo
UTILS_CMI=
PARSING=parsing/location.cmo parsing/longident.cmo \
typing/tast_iterator.cmo typing/tast_mapper.cmo typing/stypes.cmo \
file_formats/cmt_format.cmo typing/cmt2annot.cmo typing/untypeast.cmo \
typing/includemod.cmo typing/typetexp.cmo typing/printpat.cmo \
- typing/parmatch.cmo \
+ typing/patterns.cmo typing/parmatch.cmo \
typing/typedecl_properties.cmo typing/typedecl_variance.cmo \
typing/typedecl_unboxed.cmo typing/typedecl_immediacy.cmo \
typing/typedecl_separability.cmo \
BYTECOMP=bytecomp/instruct.cmo bytecomp/bytegen.cmo \
bytecomp/printinstr.cmo bytecomp/emitcode.cmo \
bytecomp/bytelink.cmo bytecomp/bytelibrarian.cmo bytecomp/bytepackager.cmo \
- driver/errors.cmo driver/compile.cmo
+ driver/errors.cmo driver/compile.cmo driver/maindriver.cmo
BYTECOMP_CMI=
-ARCH_SPECIFIC =\
- asmcomp/arch.ml asmcomp/proc.ml asmcomp/CSE.ml asmcomp/selection.ml \
- asmcomp/scheduling.ml asmcomp/reload.ml
-ARCH_SPECIFIC_CMI=
-
INTEL_ASM=\
asmcomp/x86_proc.cmo \
asmcomp/x86_dsl.cmo \
asmcomp/x86_ast.cmi
ARCH_SPECIFIC_ASMCOMP=
+ARCH_SPECIFIC_ASMCOMP_CMI=
ifeq ($(ARCH),i386)
ARCH_SPECIFIC_ASMCOMP=$(INTEL_ASM)
ARCH_SPECIFIC_ASMCOMP_CMI=$(INTEL_ASM_CMI)
asmcomp/cmmgen.cmo \
asmcomp/interval.cmo \
asmcomp/printmach.cmo asmcomp/selectgen.cmo \
- asmcomp/spacetime_profiling.cmo asmcomp/selection.cmo \
+ asmcomp/selection.cmo \
asmcomp/comballoc.cmo \
asmcomp/CSEgen.cmo asmcomp/CSE.cmo \
asmcomp/liveness.cmo \
asmcomp/reloadgen.cmo asmcomp/reload.cmo \
asmcomp/deadcode.cmo \
asmcomp/linear.cmo asmcomp/printlinear.cmo asmcomp/linearize.cmo \
+ file_formats/linear_format.cmo \
asmcomp/debug/available_regs.cmo \
asmcomp/debug/compute_ranges_intf.cmo \
asmcomp/debug/compute_ranges.cmo \
asmcomp/branch_relaxation.cmo \
asmcomp/emitaux.cmo asmcomp/emit.cmo asmcomp/asmgen.cmo \
asmcomp/asmlink.cmo asmcomp/asmlibrarian.cmo asmcomp/asmpackager.cmo \
- driver/opterrors.cmo driver/optcompile.cmo
+ driver/opterrors.cmo driver/optcompile.cmo driver/optmaindriver.cmo
ASMCOMP_CMI=$(ARCH_SPECIFIC_ASMCOMP_CMI)
# Files under middle_end/ are not to reference files under asmcomp/.
OPTTOPLEVEL_CMI=
-$(COMMON:.cmo=.cmx) $(BYTECOMP:.cmo=.cmx) $(OPTCOMP:.cmo=.cmx): ocamlopt
-$(OPTTOPLEVEL:.cmo=.cmx): ocamlopt
+$(COMMON:.cmo=.cmx) $(BYTECOMP:.cmo=.cmx) $(OPTCOMP:.cmo=.cmx): ocamlopt$(EXE)
+$(OPTTOPLEVEL:.cmo=.cmx): ocamlopt$(EXE)
compilerlibs/ocamlcommon.cma: $(COMMON_CMI) $(COMMON)
fi
fi
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.69 for OCaml 4.11.2.
+# Generated by GNU Autoconf 2.69 for OCaml 4.12.0.
#
# Report bugs to <caml-list@inria.fr>.
#
# Identity of this package.
PACKAGE_NAME='OCaml'
PACKAGE_TARNAME='ocaml'
-PACKAGE_VERSION='4.11.2'
-PACKAGE_STRING='OCaml 4.11.2'
+PACKAGE_VERSION='4.12.0'
+PACKAGE_STRING='OCaml 4.12.0'
PACKAGE_BUGREPORT='caml-list@inria.fr'
PACKAGE_URL='http://www.ocaml.org'
PTHREAD_LIBS
PTHREAD_CC
ax_pthread_config
+rlwrap
+SYSTEM_AS
DIRECT_LD
INSTALL_DATA
INSTALL_SCRIPT
INSTALL_PROGRAM
+ac_ct_DEP_CC
+DEP_CC
CPP
LT_SYS_LIBRARY_PATH
OTOOL64
LD
DEFAULT_STRING
WINDOWS_UNICODE_MODE
-BFD_LIB_DIR
-BFD_INCLUDE_DIR
-LIBUNWIND_LIB_DIR
-LIBUNWIND_INCLUDE_DIR
DLLIBS
PARTIALLD
target_os
build_vendor
build_cpu
build
+naked_pointers_checker
+naked_pointers
+compute_deps
stdlib_manpages
PACKLD
flexlink_flags
function_sections
flat_float_array
windows_unicode
-max_testsuite_dir_retries
flambda_invariants
flambda
-libunwind_link_flags
-libunwind_include_flags
-libunwind_available
-call_counts
-spacetime
frame_pointers
profinfo_width
profinfo
AS
endianness
ASPP
-bfd_ldlibs
-bfd_ldflags
-bfd_cppflags
x_libraries
x_includes
pthread_link
ocamlc_cflags
nativecclibs
bytecclibs
+oc_dll_ldflags
oc_ldflags
oc_cppflags
oc_cflags
enable_option_checking
enable_debug_runtime
enable_debugger
+enable_dependency_generation
enable_instrumented_runtime
enable_vmthreads
enable_systhreads
-with_libunwind
-with_bfd
enable_graph_lib
enable_str_lib
enable_unix_lib
enable_ocamltest
enable_frame_pointers
enable_naked_pointers
-enable_spacetime
-enable_call_counts
+enable_naked_pointers_checker
enable_cfi
enable_installing_source_artifacts
enable_installing_bytecode_programs
with_target_bindir
enable_reserved_header_bits
enable_stdlib_manpages
+enable_warn_error
enable_force_safe_string
enable_flat_float_array
enable_function_sections
ASPP
PARTIALLD
DLLIBS
-LIBUNWIND_INCLUDE_DIR
-LIBUNWIND_LIB_DIR
-BFD_INCLUDE_DIR
-BFD_LIB_DIR
WINDOWS_UNICODE_MODE
DEFAULT_STRING
CC
# 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.11.2 to adapt to many kinds of systems.
+\`configure' configures OCaml 4.12.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.11.2:";;
+ short | recursive ) echo "Configuration of OCaml 4.12.0:";;
esac
cat <<\_ACEOF
--enable-FEATURE[=ARG] include FEATURE [ARG=yes]
--disable-debug-runtime do not build runtime with debugging support
--enable-debugger build the debugger [default=auto]
+ --disable-dependency-generation
+ do not compute dependency information for C sources
--enable-instrumented-runtime
build the instrumented runtime [default=auto]
--enable-frame-pointers use frame pointers in runtime and generated code
--disable-naked-pointers
do not allow naked pointers
- --enable-spacetime build the spacetime profiler
- --disable-call-counts disable the call counts in spacetime
+ --enable-naked-pointers-checker
+ enable the naked pointers checker
--disable-cfi disable the CFI directives in assembly files
--enable-installing-source-artifacts
install *.cmt* and *.mli files
headers for profiling info
--disable-stdlib-manpages
do not build or install the library man pages
+ --enable-warn-error treat C compiler warnings as errors
--disable-force-safe-string
do not force strings to be safe
--disable-flat-float-array
Optional Packages:
--with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
--without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
- --without-libunwind disable libunwind support for Spacetime profiling
- --without-bfd disable BFD (Binary File Description) library
- support
--with-target-bindir location of binary programs on target system
--with-afl use the AFL fuzzer
--with-pic[=PKGS] try to use only PIC/non-PIC objects [default=use
PARTIALLD how to build partial (relocatable) object files
DLLIBS which libraries to use (in addition to -ldl) to load dynamic
libs
- LIBUNWIND_INCLUDE_DIR
- location of header files for libunwind
- LIBUNWIND_LIB_DIR
- location of library files for libunwind
- BFD_INCLUDE_DIR
- location of header files for the BFD library
- BFD_LIB_DIR location of library files for the BFD library
WINDOWS_UNICODE_MODE
how to handle Unicode under Windows: ansi, compatible
DEFAULT_STRING
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-OCaml configure 4.11.2
+OCaml configure 4.12.0
generated by GNU Autoconf 2.69
Copyright (C) 2012 Free Software Foundation, Inc.
} # ac_fn_c_compute_int
+# ac_fn_c_check_decl LINENO SYMBOL VAR INCLUDES
+# ---------------------------------------------
+# Tests whether SYMBOL is declared in INCLUDES, setting cache variable VAR
+# accordingly.
+ac_fn_c_check_decl ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ as_decl_name=`echo $2|sed 's/ *(.*//'`
+ as_decl_use=`echo $2|sed -e 's/(/((/' -e 's/)/) 0&/' -e 's/,/) 0& (/g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $as_decl_name is declared" >&5
+$as_echo_n "checking whether $as_decl_name is declared... " >&6; }
+if eval \${$3+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$4
+int
+main ()
+{
+#ifndef $as_decl_name
+#ifdef __cplusplus
+ (void) $as_decl_use;
+#else
+ (void) $as_decl_name;
+#endif
+#endif
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ eval "$3=yes"
+else
+ eval "$3=no"
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+eval ac_res=\$$3
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+
+} # ac_fn_c_check_decl
+
# ac_fn_c_check_member LINENO AGGR MEMBER VAR INCLUDES
# ----------------------------------------------------
# Tries to find if the field MEMBER exists in type AGGR, after including
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.11.2, which was
+It was created by OCaml $as_me 4.12.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.11.2" >&5
-$as_echo "$as_me: Configuring OCaml version 4.11.2" >&6;}
+{ $as_echo "$as_me:${as_lineno-$LINENO}: Configuring OCaml version 4.12.0" >&5
+$as_echo "$as_me: Configuring OCaml version 4.12.0" >&6;}
# Configuration variables
libraries_man_section=3
# Command to build executalbes
-mkexe="\$(CC) \$(OC_CFLAGS) \$(OC_CPPFLAGS) \$(OC_LDFLAGS)"
+# In general this command is supposed to use the CFLAGs-related variables
+# ($OC_CFLAGS and $CFLAGS), but at the moment they are not taken into
+# account on Windows, because flexlink, which is used to build
+# executables on this platform, can not handle them.
+mkexe="\$(CC) \$(OC_CFLAGS) \$(CFLAGS) \$(OC_LDFLAGS)"
# Flags for building executable files with debugging symbols
mkexedebugflag="-g"
ocamlc_cflags=""
ocamlc_cppflags=""
oc_ldflags=""
+oc_dll_ldflags=""
with_sharedlibs=true
ostype="Unix"
iflexdir=""
## Source directory
-## Directory containing auxiliary scripts used dugring build
+## Directory containing auxiliary scripts used during build
ac_aux_dir=
for ac_dir in build-aux "$srcdir"/build-aux; do
if test -f "$ac_dir/install-sh"; then
-VERSION=4.11.2
+VERSION=4.12.0
# Note: This is present for the flexdll bootstrap where it exposed as the old
- # TODO: rename this variable
-
-
-
-
-
+ # TODO: rename this variable
## Generated files
-ac_config_files="$ac_config_files Makefile.common"
+ac_config_files="$ac_config_files Makefile.build_config"
ac_config_files="$ac_config_files Makefile.config"
SO=dll
outputexe=-Fe
syslib='$(1).lib' ;; #(
+ i386-*-solaris*) :
+ as_fn_error $? "Building for 32 bits target is not supported. \
+If your host is 64 bits, you can try with './configure CC=\"gcc -m64\"' \
+(or \"cc -m64\" if you don't have GCC)." "$LINENO" 5 ;; #(
*) :
ccomptype=cc
S=s
fi
+# Check whether --enable-dependency-generation was given.
+if test "${enable_dependency_generation+set}" = set; then :
+ enableval=$enable_dependency_generation;
+else
+ enable_dependency_generation=auto
+fi
+
+
# Check whether --enable-instrumented-runtime was given.
fi
-
-# Check whether --with-libunwind was given.
-if test "${with_libunwind+set}" = set; then :
- withval=$with_libunwind;
-fi
-
-
-
-
-
-
-
-# Check whether --with-bfd was given.
-if test "${with_bfd+set}" = set; then :
- withval=$with_bfd;
-else
- with_bfd=auto
-fi
-
-
-
-
-
-
# Check whether --enable-graph-lib was given.
if test "${enable_graph_lib+set}" = set; then :
enableval=$enable_graph_lib; as_fn_error $? "The graphics library is no longer distributed with OCaml \
fi
-# Check whether --enable-spacetime was given.
-if test "${enable_spacetime+set}" = set; then :
- enableval=$enable_spacetime;
-fi
-
-
-# Check whether --enable-call-counts was given.
-if test "${enable_call_counts+set}" = set; then :
- enableval=$enable_call_counts;
+# Check whether --enable-naked-pointers-checker was given.
+if test "${enable_naked_pointers_checker+set}" = set; then :
+ enableval=$enable_naked_pointers_checker;
fi
0) :
with_profinfo=false
profinfo_width=0 ;; #(
- [1-9]|1[0-9]|2[0-1]) :
+ [1-9]|[1-2][0-9]|3[0-1]) :
with_profinfo=true
profinfo_width="$enable_reserved_header_bits" ;; #(
*) :
fi
+# Check whether --enable-warn-error was given.
+if test "${enable_warn_error+set}" = set; then :
+ enableval=$enable_warn_error;
+fi
+
+
# There are two configure-time string safety options,
fi
# libtool expects host_os=mingw for native Windows
+# Also, it has been observed that, on some platforms (e.g. msvc) LT_INIT
+# alters the CFLAGS variable, so we save its value before calling the macro
+# and restore it after the call
old_host_os=$host_os
if test x"$host_os" = "xwindows"; then :
host_os=mingw
fi
+saved_CFLAGS="$CFLAGS"
case `pwd` in
*\ * | *\ *)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Libtool does not cope well with whitespace in \`pwd\`" >&5
# Only expand once:
+CFLAGS="$saved_CFLAGS"
host_os=$old_host_os
+case $host in #(
+ sparc-sun-solaris*) :
+ DEP_CC="false" ;; #(
+ *-pc-windows) :
+ if test -n "$ac_tool_prefix"; then
+ for ac_prog in $DEP_CC gcc cc x86_64-w64-mingw32-gcc i686-w64-mingw32-gcc
+ do
+ # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
+set dummy $ac_tool_prefix$ac_prog; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_DEP_CC+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ if test -n "$DEP_CC"; then
+ ac_cv_prog_DEP_CC="$DEP_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_DEP_CC="$ac_tool_prefix$ac_prog"
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+ done
+IFS=$as_save_IFS
+
+fi
+fi
+DEP_CC=$ac_cv_prog_DEP_CC
+if test -n "$DEP_CC"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $DEP_CC" >&5
+$as_echo "$DEP_CC" >&6; }
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+ test -n "$DEP_CC" && break
+ done
+fi
+if test -z "$DEP_CC"; then
+ ac_ct_DEP_CC=$DEP_CC
+ for ac_prog in $DEP_CC gcc cc x86_64-w64-mingw32-gcc i686-w64-mingw32-gcc
+do
+ # Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_DEP_CC+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ if test -n "$ac_ct_DEP_CC"; then
+ ac_cv_prog_ac_ct_DEP_CC="$ac_ct_DEP_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_DEP_CC="$ac_prog"
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+ done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_DEP_CC=$ac_cv_prog_ac_ct_DEP_CC
+if test -n "$ac_ct_DEP_CC"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_DEP_CC" >&5
+$as_echo "$ac_ct_DEP_CC" >&6; }
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+ test -n "$ac_ct_DEP_CC" && break
+done
+
+ if test "x$ac_ct_DEP_CC" = x; then
+ DEP_CC="false"
+ else
+ case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+ DEP_CC=$ac_ct_DEP_CC
+ fi
+fi
+ ;; #(
+ *) :
+ DEP_CC="$CC" ;;
+esac
+
+case $enable_dependency_generation in #(
+ yes) :
+ if test "$DEP_CC" = "false"; then :
+ as_fn_error $? "The MSVC ports cannot generate dependency information. Install gcc (or another CC-like compiler)" "$LINENO" 5
+else
+ compute_deps=true
+fi ;; #(
+ no) :
+ compute_deps=false ;; #(
+ *) :
+ if test -e .git; then :
+ if test "$DEP_CC" = "false"; then :
+ compute_deps=false
+else
+ compute_deps=true
+fi
+else
+ compute_deps=false
+fi ;;
+esac
+
# Extracting information from libtool's configuration
if test -n "$RANLIB" ; then :
RANLIBCMD="$RANLIB"
gcc __GNUC__ __GNUC_MINOR__
#elif defined(__xlc__) && defined(__xlC__)
xlc __xlC__ __xlC_ver__
+#elif defined(__SUNPRO_C)
+sunc __SUNPRO_C __SUNPRO_C
#else
unknown
#endif
xlc-*) :
CPP="$CC -E -qnoppline" ;; #(
# suppress incompatible XLC line directives
+ sunc-*) :
+ CPP="$CC -E -Qn" ;; #(
+ # suppress generation of Sun PRO ident string
msvc-*) :
CPP="$CC -nologo -EP" ;; #(
*) :
case $ocaml_cv_cc_vendor in #(
xlc-*) :
- outputobj='-o $(EMPTY)'; gcc_warnings="-qflag=i:i" ;; #(
+ outputobj='-o $(EMPTY)'
+ warn_error_flag=''
+ cc_warnings='-qflag=i:i' ;; #(
# all warnings enabled
+ sunc-*) :
+ outputobj='-o $(EMPTY)'; cc_warnings="" ;; #(
msvc-*) :
- outputobj=-Fo; gcc_warnings="" ;; #(
+ outputobj='-Fo'
+ warn_error_flag='-WX'
+ cc_warnings='' ;; #(
*) :
outputobj='-o $(EMPTY)'
- gcc_warnings='-Wall -Wdeclaration-after-statement'
- case 4.11.2 in #(
- *+dev*) :
- gcc_warnings="$gcc_warnings -Werror" ;; #(
+ warn_error_flag='-Werror'
+ cc_warnings='-Wall -Wdeclaration-after-statement' ;;
+esac
+
+case $enable_warn_error,4.12.0 in #(
+ yes,*|,*+dev*) :
+ cc_warnings="$cc_warnings $warn_error_flag" ;; #(
*) :
;;
esac
- ;;
-esac
# We select high optimization levels, provided we can turn off:
# - strict type-based aliasing analysis (too risky for the OCaml runtime)
gcc-[01234]-*) :
as_fn_error $? "This version of Mingw GCC is too old. Please use GCC version 5 or above." "$LINENO" 5 ;; #(
gcc-*) :
- internal_cflags="-Wno-unused $gcc_warnings \
+ internal_cflags="-Wno-unused $cc_warnings \
-fexcess-precision=standard"
# TODO: see whether the code can be fixed to avoid -Wno-unused
common_cflags="-O2 -fno-strict-aliasing -fwrapv -mms-bitfields"
case $ocaml_cv_cc_vendor in #(
clang-*) :
common_cflags="-O2 -fno-strict-aliasing -fwrapv";
- internal_cflags="$gcc_warnings -fno-common" ;; #(
+ internal_cflags="$cc_warnings -fno-common" ;; #(
gcc-[012]-*) :
# Some versions known to miscompile OCaml, e,g, 2.7.2.1, some 2.96.
# Plus: C99 support unknown.
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Consider using GCC version 4.2 or above." >&5
$as_echo "$as_me: WARNING: Consider using GCC version 4.2 or above." >&2;};
common_cflags="-std=gnu99 -O";
- internal_cflags="$gcc_warnings" ;; #(
+ internal_cflags="$cc_warnings" ;; #(
gcc-4-[234]) :
# No -fexcess-precision option before GCC 4.5
common_cflags="-std=gnu99 -O2 -fno-strict-aliasing -fwrapv \
-fno-builtin-memcmp";
- internal_cflags="$gcc_warnings" ;; #(
+ internal_cflags="$cc_warnings" ;; #(
gcc-4-*) :
common_cflags="-std=gnu99 -O2 -fno-strict-aliasing -fwrapv \
-fno-builtin-memcmp";
- internal_cflags="$gcc_warnings -fexcess-precision=standard" ;; #(
+ internal_cflags="$cc_warnings -fexcess-precision=standard" ;; #(
gcc-*) :
common_cflags="-O2 -fno-strict-aliasing -fwrapv";
- internal_cflags="$gcc_warnings -fno-common \
+ internal_cflags="$cc_warnings -fno-common \
-fexcess-precision=standard" ;; #(
msvc-*) :
- common_cflags="-nologo -O2 -Gy- -MD"
+ common_cflags="-nologo -O2 -Gy- -MD $cc_warnings"
common_cppflags="-D_CRT_SECURE_NO_DEPRECATE"
internal_cppflags='-DUNICODE -D_UNICODE'
internal_cppflags="$internal_cppflags -DWINDOWS_UNICODE="
internal_cppflags="${internal_cppflags}\$(WINDOWS_UNICODE)" ;; #(
xlc-*) :
- common_cflags="-O5 -qtune=balanced -qnoipa -qinline $CFLAGS";
- internal_cflags="$gcc_warnings" ;; #(
+ common_cflags="-O5 -qtune=balanced -qnoipa -qinline";
+ internal_cflags="$cc_warnings" ;; #(
+ sunc-*) :
+ # Optimization should be >= O4 to inline functions
+ # and prevent unresolved externals
+ common_cflags="-O4 -xc99=all -D_XPG6 $CFLAGS";
+ internal_cflags="$cc_warnings" ;; #(
*) :
common_cflags="-O" ;;
esac ;;
if $with_sharedlibs; then :
case $host in #(
i686-*-*) :
- flexdll_chain="mingw" ;; #(
+ flexdll_chain="mingw"; oc_dll_ldflags="-static-libgcc" ;; #(
x86_64-*-*) :
flexdll_chain="mingw64" ;; #(
*) :
fi
ostype="Win32"
toolchain="mingw"
- mkexe='$(MKEXE_ANSI) $(if $(OC_LDFLAGS),-link "$(OC_LDFLAGS)")'
+ mkexe='$(FLEXLINK) -exe $(if $(OC_LDFLAGS),-link "$(OC_LDFLAGS)")'
oc_ldflags='-municode'
SO="dll" ;; #(
*,*-pc-windows) :
toolchain=msvc
ostype="Win32"
- mkexe='$(MKEXE_ANSI) $(if $(OC_LDFLAGS),-link "$(OC_LDFLAGS)")'
+ mkexe='$(FLEXLINK) -exe $(if $(OC_LDFLAGS),-link "$(OC_LDFLAGS)")'
oc_ldflags='/ENTRY:wmainCRTStartup'
case $host in #(
i686-pc-windows) :
oc_ldflags="-brtl -bexpfull"
$as_echo "#define HAS_ARCH_CODE32 1" >>confdefs.h
;; #(
+ gcc*,powerpc-*-linux*) :
+ oc_ldflags="-mbss-plt" ;; #(
*) :
;;
esac
fi
-ac_fn_c_check_header_mongrel "$LINENO" "sys/shm.h" "ac_cv_header_sys_shm_h" "$ac_includes_default"
-if test "x$ac_cv_header_sys_shm_h" = xyes; then :
- $as_echo "#define HAS_SYS_SHM_H 1" >>confdefs.h
-
-fi
-
-
ac_fn_c_check_header_compile "$LINENO" "dirent.h" "ac_cv_header_dirent_h" "#include <sys/types.h>
"
if test "x$ac_cv_header_dirent_h" = xyes; then :
yes)
$as_echo "#define ARCH_BIG_ENDIAN 1" >>confdefs.h
-,
+
endianness="be"
;; #(
no)
*-*-mingw32) :
mksharedlib='$(FLEXLINK)'
mkmaindll='$(FLEXLINK) -maindll'
+ if test -n "$oc_dll_ldflags"; then :
+
+ mksharedlib="$mksharedlib -link \"$oc_dll_ldflags\""
+ mkmaindll="$mkmaindll -link \"$oc_dll_ldflags\""
+fi
shared_libraries_supported=$with_sharedlibs ;; #(
*-pc-windows) :
mksharedlib='$(FLEXLINK)'
mkmaindll="$flexlink -maindll"
shared_libraries_supported=true ;; #(
powerpc-ibm-aix*) :
- case $CC in #(
+ case $ocaml_cv_cc_vendor in #(
xlc*) :
mksharedlib="$CC -qmkshrobj -G"
shared_libraries_supported=true ;; #(
*) :
;;
esac ;; #(
+ *-*-solaris*) :
+ sharedlib_cflags="-fPIC"
+ mksharedlib="$CC -shared"
+ rpath="-Wl,-rpath,"
+ mksharedlibrpath="-Wl,-rpath,"
+ shared_libraries_supported=true ;; #(
*-*-linux*|*-*-freebsd[3-9]*|*-*-freebsd[1-9][0-9]*\
|*-*-openbsd*|*-*-netbsd*|*-*-dragonfly*|*-*-gnu*|*-*-haiku*) :
sharedlib_cflags="-fPIC"
- mksharedlib="$CC -shared"
+ case $CC,$host in #(
+ gcc*,powerpc-*-linux*) :
+ mksharedlib="$CC -shared -mbss-plt" ;; #(
+ *) :
+ mksharedlib="$CC -shared" ;;
+esac
oc_ldflags="$oc_ldflags -Wl,-E"
rpath="-Wl,-rpath,"
mksharedlibrpath="-Wl,-rpath,"
natdynlink=true ;; #(
x86_64-*-linux*) :
natdynlink=true ;; #(
+ arm64-*-darwin*) :
+ natdynlink=true ;; #(
+ aarch64-*-darwin*) :
+ natdynlink=true ;; #(
x86_64-*-darwin*) :
natdynlink=true ;; #(
s390x*-*-linux*) :
natdynlink=true ;; #(
powerpc*-*-linux*) :
natdynlink=true ;; #(
+ x86_64-*-solaris*) :
+ natdynlink=true ;; #(
i686-*-kfreebsd*) :
natdynlink=true ;; #(
x86_64-*-kfreebsd*) :
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+## Check whether __attribute__((optimize("tree-vectorize")))) is supported
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler supports __attribute__((optimize(\"tree-vectorize\")))" >&5
+$as_echo_n "checking whether the C compiler supports __attribute__((optimize(\"tree-vectorize\")))... " >&6; }
+ saved_CFLAGS="$CFLAGS"
+ CFLAGS="-Werror $CFLAGS"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+ __attribute__((optimize("tree-vectorize"))) void f(void){}
+ int main() { f(); return 0; }
+
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ $as_echo "#define SUPPORTS_TREE_VECTORIZE 1" >>confdefs.h
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ CFLAGS="$saved_CFLAGS"
+
+
# Configure the native-code compiler
arch=none
arch=amd64; system=gnu ;; #(
x86_64-*-dragonfly*) :
arch=amd64; system=dragonfly ;; #(
+ x86_64-*-solaris*) :
+ arch=amd64; system=solaris ;; #(
x86_64-*-freebsd*) :
arch=amd64; system=freebsd ;; #(
x86_64-*-netbsd*) :
arch=amd64; system=netbsd ;; #(
x86_64-*-openbsd*) :
arch=amd64; system=openbsd ;; #(
+ arm64-*-darwin*) :
+ arch=arm64; system=macosx ;; #(
+ aarch64-*-darwin*) :
+ arch=arm64; system=macosx ;; #(
x86_64-*-darwin*) :
arch=amd64; system=macosx ;; #(
x86_64-*-mingw32) :
esac
if test x"$enable_native_compiler" = "xno"; then :
- arch=none; model=default; system=unknown; native_compiler=false
+ native_compiler=false
{ $as_echo "$as_me:${as_lineno-$LINENO}: the native compiler is disabled" >&5
$as_echo "$as_me: the native compiler is disabled" >&6;}
else
fi
if test -z "$PARTIALLD"; then :
- # 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).
case "$arch,$CC,$system,$model" in #(
amd64,gcc*,macosx,*) :
- PACKLD='ld -r -arch x86_64 -o $(EMPTY)' ;; #(
- amd64,gcc*,solaris,*) :
- PACKLD='ld -r -m elf_x86_64 -o $(EMPTY)' ;; #(
+ PACKLD_FLAGS=' -arch x86_64' ;; #(
power,gcc*,elf,ppc) :
- PACKLD='ld -r -m elf32ppclinux -o $(EMPTY)' ;; #(
+ PACKLD_FLAGS=' -m elf32ppclinux' ;; #(
power,gcc*,elf,ppc64) :
- PACKLD='ld -r -m elf64ppc -o $(EMPTY)' ;; #(
+ PACKLD_FLAGS=' -m elf64ppc' ;; #(
power,gcc*,elf,ppc64le) :
- PACKLD='ld -r -m elf64lppc -o $(EMPTY)' ;; #(
- # For the Microsoft C compiler there must be no space at the end of the
- # string.
- *,cl,*,*) :
- PACKLD="link -lib -nologo $machine -out:" ;; #(
+ PACKLD_FLAGS=' -m elf64lppc' ;; #(
*) :
- PACKLD="$DIRECT_LD -r -o \$(EMPTY)" ;;
+ PACKLD_FLAGS='' ;;
esac
+ # 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).
+ if test x"$CC" = "xcl"; then :
+ # For the Microsoft C compiler there must be no space at the end of the
+ # string.
+ PACKLD="link -lib -nologo $machine -out:"
else
- PACKLD="$PARTIALLD -o \$(EMPTY)"
+ PACKLD="$DIRECT_LD -r$PACKLD_FLAGS -o \$(EMPTY)"
fi
-
-if test $arch != "none" && $arch64 ; then :
- otherlibraries="$otherlibraries raw_spacetime_lib"
+else
+ PACKLD="$PARTIALLD -o \$(EMPTY)"
fi
# Disable PIE at link time when ocamlopt does not produce position-independent
# One may want to check whether the user provided values first
# and only compute values if none has been provided
-case "$arch,$system" in #(
- i386,win32) :
- default_as="ml -nologo -coff -Cp -c -Fo" ;; #(
- amd64,win64) :
- default_as="ml64 -nologo -Cp -c -Fo" ;; #(
- amd64,macosx) :
- case $ocaml_cv_cc_vendor in #(
- clang-*) :
- default_as='clang -arch x86_64 -Wno-trigraphs -c'
- default_aspp='clang -arch x86_64 -Wno-trigraphs -c' ;; #(
- *) :
- default_as="${toolpref}as -arch x86_64"
- default_aspp="${toolpref}gcc -arch x86_64 -c" ;;
-esac ;; #(
- amd64,solaris) :
- default_as="${toolpref}as --64"
- default_aspp="${toolpref}gcc -m64 -c" ;; #(
- i386,solaris) :
- default_as="${toolpref}as"
- default_aspp="${toolpref}gcc -c" ;; #(
- power,elf) :
- case $model in #(
- ppc64le) :
- default_as="${toolpref}as -a64 -mpower8"
- default_aspp="${toolpref}gcc -m64 -mcpu=powerpc64le -c" ;; #(
- ppc64) :
- default_as="${toolpref}as -a64 -mppc64"
- default_aspp="${toolpref}gcc -m64 -c" ;; #(
- ppc) :
- default_as="${toolpref}as -mppc"
- default_aspp="${toolpref}gcc -m32 -c" ;; #(
- *) :
- ;;
-esac ;; #(
- s390x,elf) :
- default_as="${toolpref}as -m 64 -march=$model"
- default_aspp="${toolpref}gcc -c -Wa,-march=$model" ;; #(
- *,freebsd) :
- default_as="${toolpref}cc -c -Wno-trigraphs"
+if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "${ac_tool_prefix}as", so it can be a program name with args.
+set dummy ${ac_tool_prefix}as; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_SYSTEM_AS+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ if test -n "$SYSTEM_AS"; then
+ ac_cv_prog_SYSTEM_AS="$SYSTEM_AS" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_SYSTEM_AS="${ac_tool_prefix}as"
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+ done
+IFS=$as_save_IFS
+
+fi
+fi
+SYSTEM_AS=$ac_cv_prog_SYSTEM_AS
+if test -n "$SYSTEM_AS"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $SYSTEM_AS" >&5
+$as_echo "$SYSTEM_AS" >&6; }
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_SYSTEM_AS"; then
+ ac_ct_SYSTEM_AS=$SYSTEM_AS
+ # Extract the first word of "as", so it can be a program name with args.
+set dummy as; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_SYSTEM_AS+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ if test -n "$ac_ct_SYSTEM_AS"; then
+ ac_cv_prog_ac_ct_SYSTEM_AS="$ac_ct_SYSTEM_AS" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_SYSTEM_AS="as"
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+ done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_SYSTEM_AS=$ac_cv_prog_ac_ct_SYSTEM_AS
+if test -n "$ac_ct_SYSTEM_AS"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_SYSTEM_AS" >&5
+$as_echo "$ac_ct_SYSTEM_AS" >&6; }
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+ if test "x$ac_ct_SYSTEM_AS" = x; then
+ SYSTEM_AS=""
+ else
+ case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+ SYSTEM_AS=$ac_ct_SYSTEM_AS
+ fi
+else
+ SYSTEM_AS="$ac_cv_prog_SYSTEM_AS"
+fi
+
+
+case "$arch,$system" in #(
+ i386,win32) :
+ default_as="ml -nologo -coff -Cp -c -Fo" ;; #(
+ amd64,win64) :
+ default_as="ml64 -nologo -Cp -c -Fo" ;; #(
+ amd64,macosx) :
+ case $ocaml_cv_cc_vendor in #(
+ clang-*) :
+ default_as='clang -arch x86_64 -Wno-trigraphs -c'
+ default_aspp='clang -arch x86_64 -Wno-trigraphs -c' ;; #(
+ *) :
+ default_as="${toolpref}as -arch x86_64"
+ default_aspp="${toolpref}gcc -arch x86_64 -c" ;;
+esac ;; #(
+ amd64,solaris) :
+ case $ocaml_cv_cc_vendor in #(
+ sunc-*) :
+ if test x"$SYSTEM_AS" = "x"; then :
+ as_fn_error $? "GNU as assembler is required." "$LINENO" 5
+else
+ default_as="${toolpref}as --64"
+ default_aspp="${toolpref}cc -m64 -c"
+fi ;; #(
+ gcc-*) :
+ if test x"$SYSTEM_AS" = "x"; then :
+ default_as="${toolpref}gcc -m64 -c"
+ default_aspp="${toolpref}gcc -m64 -c"
+else
+ default_as="${toolpref}as --64"
+ default_aspp="${toolpref}gcc -m64 -c"
+fi ;; #(
+ *) :
+ ;;
+esac ;; #(
+ power,elf) :
+ case $model in #(
+ ppc64le) :
+ default_as="${toolpref}as -a64 -mpower8"
+ default_aspp="${toolpref}gcc -m64 -mcpu=powerpc64le -c" ;; #(
+ ppc64) :
+ default_as="${toolpref}as -a64 -mppc64"
+ default_aspp="${toolpref}gcc -m64 -c" ;; #(
+ ppc) :
+ default_as="${toolpref}as -mppc"
+ default_aspp="${toolpref}gcc -m32 -c" ;; #(
+ *) :
+ ;;
+esac ;; #(
+ s390x,elf) :
+ default_as="${toolpref}as -m 64 -march=$model"
+ default_aspp="${toolpref}gcc -c -Wa,-march=$model" ;; #(
+ *,freebsd) :
+ default_as="${toolpref}cc -c -Wno-trigraphs"
default_aspp="${toolpref}cc -c -Wno-trigraphs" ;; #(
*,dragonfly) :
default_as="${toolpref}as"
ASPP="$default_aspp"
fi
+# Utilities
+# Extract the first word of "rlwrap", so it can be a program name with args.
+set dummy rlwrap; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_rlwrap+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ if test -n "$rlwrap"; then
+ ac_cv_prog_rlwrap="$rlwrap" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_rlwrap="rlwrap"
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+ done
+IFS=$as_save_IFS
+
+fi
+fi
+rlwrap=$ac_cv_prog_rlwrap
+if test -n "$rlwrap"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $rlwrap" >&5
+$as_echo "$rlwrap" >&6; }
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+case $rlwrap,$system in #(
+ rlwrap,win*|rlwrap,mingw*) :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: rlwrap doesn't work with native win32 - disabling" >&5
+$as_echo "$as_me: rlwrap doesn't work with native win32 - disabling" >&6;}
+ rlwrap='' ;; #(
+ *) :
+ ;;
+esac
+
# Checks for library functions
## Check the semantics of signal handlers
if test "x$enable_instrumented_runtime" != "xno" ; then :
case $host in #(
+ sparc-sun-solaris*) :
+ instrumented_runtime=false ;; #(
*-*-windows) :
instrumented_runtime=true ;; #(
*-apple-darwin*) :
*-*-haiku) :
cclibs="$cclibs -lnetwork"
sockets=true ;; #(
+ *-*-solaris*) :
+ cclibs="$cclibs -lsocket -lnsl"
+ sockets=true ;; #(
*) :
ac_fn_c_check_func "$LINENO" "socket" "ac_cv_func_socket"
fi
+ac_fn_c_check_decl "$LINENO" "system" "ac_cv_have_decl_system" "#include <stdlib.h>
+"
+if test "x$ac_cv_have_decl_system" = xyes; then :
+ $as_echo "#define HAS_SYSTEM 1" >>confdefs.h
+
+fi
+
+
## utime
## Note: this was defined in config/s-nt.h but the autoconf macros do not
# seem to detect it properly on Windows so we hardcode the definition
## -fdebug-prefix-map support by the C compiler
-case $CC,$host in #(
+case $ocaml_cv_cc_vendor,$host in #(
*,*-*-mingw32) :
cc_has_debug_prefix_map=false ;; #(
*,*-pc-windows) :
cc_has_debug_prefix_map=false ;; #(
xlc*,powerpc-ibm-aix*) :
cc_has_debug_prefix_map=false ;; #(
+ sunc*,sparc-sun-*) :
+ cc_has_debug_prefix_map=false ;; #(
*) :
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler supports -fdebug-prefix-map" >&5
fi
+## shmat
+ac_fn_c_check_header_mongrel "$LINENO" "sys/shm.h" "ac_cv_header_sys_shm_h" "$ac_includes_default"
+if test "x$ac_cv_header_sys_shm_h" = xyes; then :
+
+ $as_echo "#define HAS_SYS_SHM_H 1" >>confdefs.h
+
+ ac_fn_c_check_func "$LINENO" "shmat" "ac_cv_func_shmat"
+if test "x$ac_cv_func_shmat" = xyes; then :
+ $as_echo "#define HAS_SHMAT 1" >>confdefs.h
+
+fi
+
+
+fi
+
+
+
## execvpe
ac_fn_c_check_func "$LINENO" "execvpe" "ac_cv_func_execvpe"
fi
+## posix_spawn
+
+ac_fn_c_check_header_mongrel "$LINENO" "spawn.h" "ac_cv_header_spawn_h" "$ac_includes_default"
+if test "x$ac_cv_header_spawn_h" = xyes; then :
+ ac_fn_c_check_func "$LINENO" "posix_spawn" "ac_cv_func_posix_spawn"
+if test "x$ac_cv_func_posix_spawn" = xyes; then :
+ ac_fn_c_check_func "$LINENO" "posix_spawnp" "ac_cv_func_posix_spawnp"
+if test "x$ac_cv_func_posix_spawnp" = xyes; then :
+ $as_echo "#define HAS_POSIX_SPAWN 1" >>confdefs.h
+
+fi
+
+fi
+
+fi
+
+
+
## ffs or _BitScanForward
ac_fn_c_check_func "$LINENO" "ffs" "ac_cv_func_ffs"
systhread_support=true
otherlibraries="$otherlibraries systhreads"
case $host in #(
- *-*-solaris*) :
- pthread_link="-lpthread -lposix4" ;; #(
*-*-haiku*) :
pthread_link="" ;; #(
+ *-*-android*) :
+ pthread_link="" ;; #(
*) :
pthread_link="-lpthread" ;;
esac
esac
fi
-## BFD (Binary File Description) library
-
-bfd_cppflags=""
-bfd_ldflags=""
-bfd_ldlibs=""
-
-if test x"$with_bfd" != "xno"; then :
- bfd_available=false
- case $host in #(
- x86_64-*-darwin*) :
- if test -z "$BFD_INCLUDE_DIR"; then :
- BFD_INCLUDE_DIR="/opt/local/include"
-fi
- if test -z "$BFD_LIB_DIR"; then :
- BFD_LIB_DIR="/opt/local/lib"
-fi ;; #(
- *-*-openbsd*|*-*-freebsd*) :
- if test -z "$BFD_INCLUDE_DIR"; then :
- BFD_INCLUDE_DIR="/usr/local/include"
-fi
- if test -z "$BFD_LIB_DIR"; then :
- BFD_LIB_DIR="/usr/local/lib"
-fi ;; #(
- *) :
- ;;
-esac
- if test -n "$BFD_INCLUDE_DIR"; then :
- bfd_cppflags="-I$BFD_INCLUDE_DIR"
-fi
- if test -n "$BFD_LIB_DIR"; then :
- bfd_ldflags="-L$BFD_LIB_DIR"
-fi
- SAVED_CPPFLAGS="$CPPFLAGS"
- SAVED_LDFLAGS="$LDFLAGS"
- CPPFLAGS="$CPPFLAGS $bfd_cppflags"
- LDFLAGS="$LDFLAGS $bfd_ldflags"
- ac_fn_c_check_header_mongrel "$LINENO" "bfd.h" "ac_cv_header_bfd_h" "$ac_includes_default"
-if test "x$ac_cv_header_bfd_h" = xyes; then :
- bfd_ldlibs=""
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for bfd_openr in -lbfd" >&5
-$as_echo_n "checking for bfd_openr in -lbfd... " >&6; }
-if ${ac_cv_lib_bfd_bfd_openr+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lbfd $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char bfd_openr ();
-int
-main ()
-{
-return bfd_openr ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_bfd_bfd_openr=yes
-else
- ac_cv_lib_bfd_bfd_openr=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bfd_bfd_openr" >&5
-$as_echo "$ac_cv_lib_bfd_bfd_openr" >&6; }
-if test "x$ac_cv_lib_bfd_bfd_openr" = xyes; then :
- bfd_ldlibs="-lbfd"
-fi
-
- if test -z "$bfd_ldlibs"; then :
- unset ac_cv_lib_bfd_bfd_openr
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for bfd_openr in -lbfd" >&5
-$as_echo_n "checking for bfd_openr in -lbfd... " >&6; }
-if ${ac_cv_lib_bfd_bfd_openr+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lbfd $DLLIBS $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char bfd_openr ();
-int
-main ()
-{
-return bfd_openr ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_bfd_bfd_openr=yes
-else
- ac_cv_lib_bfd_bfd_openr=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bfd_bfd_openr" >&5
-$as_echo "$ac_cv_lib_bfd_bfd_openr" >&6; }
-if test "x$ac_cv_lib_bfd_bfd_openr" = xyes; then :
- bfd_ldlibs="-lbfd $DLLIBS"
-fi
-
-fi
- if test -z "$bfd_ldlibs"; then :
- unset ac_cv_lib_bfd_bfd_openr
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for bfd_openr in -lbfd" >&5
-$as_echo_n "checking for bfd_openr in -lbfd... " >&6; }
-if ${ac_cv_lib_bfd_bfd_openr+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lbfd $DLLIBS -liberty $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char bfd_openr ();
-int
-main ()
-{
-return bfd_openr ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_bfd_bfd_openr=yes
-else
- ac_cv_lib_bfd_bfd_openr=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bfd_bfd_openr" >&5
-$as_echo "$ac_cv_lib_bfd_bfd_openr" >&6; }
-if test "x$ac_cv_lib_bfd_bfd_openr" = xyes; then :
- bfd_ldlibs="-lbfd $DLLIBS -liberty"
-fi
-
-fi
- if test -z "$bfd_ldlibs"; then :
- unset ac_cv_lib_bfd_bfd_openr
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for bfd_openr in -lbfd" >&5
-$as_echo_n "checking for bfd_openr in -lbfd... " >&6; }
-if ${ac_cv_lib_bfd_bfd_openr+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lbfd $DLLIBS -liberty -lz $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char bfd_openr ();
-int
-main ()
-{
-return bfd_openr ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_bfd_bfd_openr=yes
-else
- ac_cv_lib_bfd_bfd_openr=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bfd_bfd_openr" >&5
-$as_echo "$ac_cv_lib_bfd_bfd_openr" >&6; }
-if test "x$ac_cv_lib_bfd_bfd_openr" = xyes; then :
- bfd_ldlibs="-lbfd $DLLIBS -liberty -lz"
-fi
-
-fi
- if test -z "$bfd_ldlibs"; then :
- unset ac_cv_lib_bfd_bfd_openr
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for bfd_openr in -lbfd" >&5
-$as_echo_n "checking for bfd_openr in -lbfd... " >&6; }
-if ${ac_cv_lib_bfd_bfd_openr+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lbfd $DLLIBS -liberty -lz -lintl $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char bfd_openr ();
-int
-main ()
-{
-return bfd_openr ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_bfd_bfd_openr=yes
-else
- ac_cv_lib_bfd_bfd_openr=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bfd_bfd_openr" >&5
-$as_echo "$ac_cv_lib_bfd_bfd_openr" >&6; }
-if test "x$ac_cv_lib_bfd_bfd_openr" = xyes; then :
- bfd_ldlibs="-lbfd $DLLIBS -liberty -lz -lintl"
-fi
-
-fi
- if test -n "$bfd_ldlibs"; then :
- bfd_available=true
- $as_echo "#define HAS_LIBBFD 1" >>confdefs.h
-
-fi
-fi
-
-
- if ! $bfd_available; then :
- if test x"$with_bfd" = "xyes"; then :
- as_fn_error $? "BFD library support requested but not available" "$LINENO" 5
-else
- bfd_cppflags=""
- bfd_ldflags=""
- { $as_echo "$as_me:${as_lineno-$LINENO}: BFD library not found, 'ocamlobjinfo' will be unable to display info on .cmxs files." >&5
-$as_echo "$as_me: BFD library not found, 'ocamlobjinfo' will be unable to display info on .cmxs files." >&6;}
-fi
-fi
- LDFLAGS="$SAVED_LDFLAGS"
- CPP_FLAGS="$SAVED_CPPFLAGS"
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: Support for the BFD (Binary File Description) library disabled, 'ocamlobjinfo' will be unable to display info on .cmxs files." >&5
-$as_echo "$as_me: Support for the BFD (Binary File Description) library disabled, 'ocamlobjinfo' will be unable to display info on .cmxs files." >&6;}
-fi
-
## Does the assembler support debug prefix map and CFI directives
as_has_debug_prefix_map=false
asm_cfi_supported=false
## No naked pointers
if test x"$enable_naked_pointers" = "xno" ; then :
- $as_echo "#define NO_NAKED_POINTERS 1" >>confdefs.h
+ naked_pointers=false
+ $as_echo "#define NO_NAKED_POINTERS 1" >>confdefs.h
+else
+ naked_pointers=true
+fi
+
+if test x"$enable_naked_pointers_checker" = "xyes" ; then :
+ if test x"$enable_naked_pointers" = "xno" ; then :
+ as_fn_error $? "--enable-naked-pointers-checker and --disable-naked-pointers are incompatible" "$LINENO" 5
+fi
+ case "$arch","$system" in #(
+ amd64,linux|amd64,macosx \
+ |amd64,openbsd|amd64,win64 \
+ |amd64,freebsd|amd64,solaris) :
+ naked_pointers_checker=true
+ $as_echo "#define NAKED_POINTERS_CHECKER 1" >>confdefs.h
+ ;; #(
+ *) :
+ as_fn_error $? "naked pointers checker not supported on this platform" "$LINENO" 5
+ ;; #(
+ *) :
+ ;;
+esac
+else
+ naked_pointers_checker=false
fi
## Check for mmap support for huge pages and contiguous heap
-# Spacetime profiling, including libunwind detection
-
-# The number of bits used for profiling information is configurable here.
-# The more bits used for profiling, the smaller will be Max_wosize.
-# Note that PROFINFO_WIDTH must still be defined even if not configuring
-# for Spacetime (see comment in runtime/caml/mlvalues.h on [Profinfo_hd]).
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to build spacetime" >&5
-$as_echo_n "checking whether to build spacetime... " >&6; }
-if test x"$enable_spacetime" != "xyes" ; then :
- spacetime=false
- call_counts=true # as in original script but should probably be false
- libunwind_available=false
- libunwind_include_flags=
- libunwind_link_flags=
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-else
- case $arch in #(
- amd64) :
- spacetime_supported=true ;; #(
- *) :
- spacetime_supported=false ;;
-esac
- if $spacetime_supported; then :
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
- spacetime=true
- profinfo=true
- profinfo_width=26
- $as_echo "#define WITH_SPACETIME 1" >>confdefs.h
-
- if test x"$enable_call_counts" != "xno"; then :
- call_counts=true
- $as_echo "#define ENABLE_CALL_COUNTS 1" >>confdefs.h
-
-else
- call_counts=false
-fi
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to use libunwind" >&5
-$as_echo_n "checking whether to use libunwind... " >&6; }
- if test x"$with_libunwind" = "xno"; then :
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: disabled" >&5
-$as_echo "disabled" >&6; }
-else
- if test x"$with_libunwind" = "x"; then :
- libunwind_requested=false
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: if available" >&5
-$as_echo "if available" >&6; }
-else
- libunwind_requested=true
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: requested" >&5
-$as_echo "requested" >&6; }
- if test x"$with_libunwind" != "xyes"; then :
- if test x"$LIBUNWIND_INCLUDE_DIR" = "x"; then :
- LIBUNWIND_INCLUDE_DIR="$with_libunwind/include"
-fi
- if test x"$LIBUNWIND_LIB_DIR" = "x"; then :
- LIBUNWIND_LIB_DIR="$with_libunwind/lib"
-fi
-
-fi
-
-fi
- if test "$system" = "macosx"; then :
- if test x"$LIBUNWIND_INCLUDE_DIR" != x -o \
- x"$LIBUNWIND_LIB_DIR" != x; then :
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: On MacOSX, specifying paths for libunwind headers or libraries is strongly discouraged. It is recommended to rely on the defaults provided by the configure script" >&5
-$as_echo "$as_me: WARNING: On MacOSX, specifying paths for libunwind headers or libraries is strongly discouraged. It is recommended to rely on the defaults provided by the configure script" >&2;}
-fi
-fi
-
- if test x"$LIBUNWIND_INCLUDE_DIR" != x; then :
- libunwind_include_flags="-I$LIBUNWIND_INCLUDE_DIR"
-else
- libunwind_include_flags=""
-fi
-
- case "$system" in #(
- "macosx") :
- libunwind_link_flags="-framework System" ;; #(
- *) :
- libunwind_link_flags="-lunwind -lunwind-x86_64" ;;
-esac
-
- if test x"$LIBUNWIND_LIB_DIR" != x; then :
- libunwind_link_flags="-L$LIBUNWIND_LIB_DIR $libunwind_link_flags"
-fi
-
-
- SAVED_CFLAGS="$CFLAGS"
- SAVED_LDFLAGS="$LDFLAGS"
- CFLAGS="$CFLAGS $libunwind_include_flags"
- LDFLAGS="$LDFLAGS $libunwind_link_flags"
- ac_fn_c_check_header_mongrel "$LINENO" "libunwind.h" "ac_cv_header_libunwind_h" "$ac_includes_default"
-if test "x$ac_cv_header_libunwind_h" = xyes; then :
- $as_echo "#define HAS_LIBUNWIND 1" >>confdefs.h
-
- libunwind_available=true
-else
- libunwind_available=false
-fi
-
-
- LDFLAGS="$SAVED_LDFLAGS"
- CFLAGS="$SAVED_CFLAGS"
-
-
- if $libunwind_requested && ! $libunwind_available; then :
- as_fn_error $? "libunwind was requested but can not be found" "$LINENO" 5
-fi
-
- # We need unwinding information at runtime, but since we use
- # -no_compact_unwind, we also need -keep_dwarf_unwind otherwise
- # the OS X linker will chuck away the DWARF-like (.eh_frame)
- # information. (Older versions of OS X don't provide this.)
-
- if $libunwind_available && test x"$system" = "xmacosx"; then :
- extra_flags="-Wl,-keep_dwarf_unwind"
- mkexe="$mkexe $extra_flags"
- mksharedlib="$mksharedlib $extra_flags"
-fi
-fi
-
-else
- if test x"$enable_spacetime" = "xyes"; then :
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: requested but not supported" >&5
-$as_echo "requested but not supported" >&6; }
- as_fn_error $? "exiting" "$LINENO" 5
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-
-fi
-
-fi
-
cat >>confdefs.h <<_ACEOF
#define PROFINFO_WIDTH $profinfo_width
_ACEOF
ocamldoc=ocamldoc
fi
-case $enable_ocamltest,4.11.2 in #(
+case $enable_ocamltest,4.12.0 in #(
yes,*|,*+dev*) :
ocamltest='ocamltest' ;; #(
*) :
oc_cflags="$common_cflags $internal_cflags"
oc_cppflags="$common_cppflags $internal_cppflags"
-ocamlc_cflags="$common_cflags $sharedlib_cflags"
-ocamlc_cppflags="$common_cppflags"
+ocamlc_cflags="$common_cflags $sharedlib_cflags \$(CFLAGS)"
+ocamlc_cppflags="$common_cppflags \$(CPPFLAGS)"
cclibs="$cclibs $mathlib"
case $host in #(
case $host in #(
*-*-mingw32|*-pc-windows) :
- max_testsuite_dir_retries=1
case $WINDOWS_UNICODE_MODE in #(
ansi) :
windows_unicode=0 ;; #(
as_fn_error $? "unexpected windows unicode mode" "$LINENO" 5 ;;
esac ;; #(
*) :
- max_testsuite_dir_retries=0
- windows_unicode=0 ;;
+ windows_unicode=0 ;;
esac
# Define flexlink chain and flags correctly for the different Windows ports
$as_echo "#define HAS_IPV6 1" >>confdefs.h
$as_echo "#define HAS_NICE 1" >>confdefs.h
+ ;; #(
+ *-*-solaris*) :
+ # This is required as otherwise floats are printed
+ # as "Infinity" and "Inf" instead of the expected "inf"
+ $as_echo "#define HAS_BROKEN_PRINTF 1" >>confdefs.h
;; #(
*) :
;;
# 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.11.2, which was
+This file was extended by OCaml $as_me 4.12.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.11.2
+OCaml config.status 4.12.0
configured by $0, generated by GNU Autoconf 2.69,
with options \\"\$ac_cs_config\\"
for ac_config_target in $ac_config_targets
do
case $ac_config_target in
- "Makefile.common") CONFIG_FILES="$CONFIG_FILES Makefile.common" ;;
+ "Makefile.build_config") CONFIG_FILES="$CONFIG_FILES Makefile.build_config" ;;
"Makefile.config") CONFIG_FILES="$CONFIG_FILES Makefile.config" ;;
"tools/eventlog_metadata") CONFIG_FILES="$CONFIG_FILES tools/eventlog_metadata" ;;
"runtime/caml/m.h") CONFIG_HEADERS="$CONFIG_HEADERS runtime/caml/m.h" ;;
libraries_man_section=3
# Command to build executalbes
-mkexe="\$(CC) \$(OC_CFLAGS) \$(OC_CPPFLAGS) \$(OC_LDFLAGS)"
+# In general this command is supposed to use the CFLAGs-related variables
+# ($OC_CFLAGS and $CFLAGS), but at the moment they are not taken into
+# account on Windows, because flexlink, which is used to build
+# executables on this platform, can not handle them.
+mkexe="\$(CC) \$(OC_CFLAGS) \$(CFLAGS) \$(OC_LDFLAGS)"
# Flags for building executable files with debugging symbols
mkexedebugflag="-g"
ocamlc_cflags=""
ocamlc_cppflags=""
oc_ldflags=""
+oc_dll_ldflags=""
with_sharedlibs=true
ostype="Unix"
iflexdir=""
## Source directory
AC_CONFIG_SRCDIR([runtime/interp.c])
-## Directory containing auxiliary scripts used dugring build
+## Directory containing auxiliary scripts used during build
AC_CONFIG_AUX_DIR([build-aux])
## Output variables
AC_SUBST([oc_cflags])
AC_SUBST([oc_cppflags])
AC_SUBST([oc_ldflags])
+AC_SUBST([oc_dll_ldflags])
AC_SUBST([bytecclibs])
AC_SUBST([nativecclibs])
AC_SUBST([ocamlc_cflags])
AC_SUBST([pthread_link])
AC_SUBST([x_includes])
AC_SUBST([x_libraries])
-AC_SUBST([bfd_cppflags])
-AC_SUBST([bfd_ldflags])
-AC_SUBST([bfd_ldlibs])
AC_SUBST([ASPP])
AC_SUBST([endianness])
AC_SUBST([AS])
AC_SUBST([profinfo])
AC_SUBST([profinfo_width])
AC_SUBST([frame_pointers])
-AC_SUBST([spacetime])
-AC_SUBST([call_counts])
-AC_SUBST([libunwind_available])
-AC_SUBST([libunwind_include_flags])
-AC_SUBST([libunwind_link_flags])
AC_SUBST([flambda])
AC_SUBST([flambda_invariants])
-AC_SUBST([max_testsuite_dir_retries])
AC_SUBST([windows_unicode])
AC_SUBST([flat_float_array])
AC_SUBST([function_sections])
AC_SUBST([flexlink_flags])
AC_SUBST([PACKLD])
AC_SUBST([stdlib_manpages])
+AC_SUBST([compute_deps])
+AC_SUBST([naked_pointers])
+AC_SUBST([naked_pointers_checker])
## Generated files
-AC_CONFIG_FILES([Makefile.common])
+AC_CONFIG_FILES([Makefile.build_config])
AC_CONFIG_FILES([Makefile.config])
AC_CONFIG_FILES([tools/eventlog_metadata])
AC_CONFIG_HEADERS([runtime/caml/m.h])
SO=dll
outputexe=-Fe
syslib='$(1).lib'],
+ [i386-*-solaris*],
+ [AC_MSG_ERROR([Building for 32 bits target is not supported. \
+If your host is 64 bits, you can try with './configure CC="gcc -m64"' \
+(or "cc -m64" if you don't have GCC).])],
[ccomptype=cc
S=s
SO=so
[],
[enable_debugger=auto])
+AC_ARG_ENABLE([dependency-generation],
+ [AS_HELP_STRING([--disable-dependency-generation],
+ [do not compute dependency information for C sources])],
+ [],
+ [enable_dependency_generation=auto])
+
AC_ARG_VAR([DLLIBS],
[which libraries to use (in addition to -ldl) to load dynamic libs])
[AS_HELP_STRING([--disable-systhreads],
[disable the Win32/POSIX threads library])])
-AC_ARG_WITH([libunwind],
- [AS_HELP_STRING([--without-libunwind],
- [disable libunwind support for Spacetime profiling])])
-
-AC_ARG_VAR([LIBUNWIND_INCLUDE_DIR],
- [location of header files for libunwind])
-
-AC_ARG_VAR([LIBUNWIND_LIB_DIR],
- [location of library files for libunwind])
-
-AC_ARG_WITH([bfd],
- [AS_HELP_STRING([--without-bfd],
- [disable BFD (Binary File Description) library support])],
- [],
- [with_bfd=auto])
-
-AC_ARG_VAR([BFD_INCLUDE_DIR],
- [location of header files for the BFD library])
-
-AC_ARG_VAR([BFD_LIB_DIR],
- [location of library files for the BFD library])
-
AC_ARG_ENABLE([graph-lib], [],
[AC_MSG_ERROR([The graphics library is no longer distributed with OCaml \
since version 4.09. It is now distributed as a separate "graphics" package: \
[AS_HELP_STRING([--disable-naked-pointers],
[do not allow naked pointers])])
-AC_ARG_ENABLE([spacetime],
- [AS_HELP_STRING([--enable-spacetime],
- [build the spacetime profiler])])
-
-AC_ARG_ENABLE([call-counts],
- [AS_HELP_STRING([--disable-call-counts],
- [disable the call counts in spacetime])])
+AC_ARG_ENABLE([naked-pointers-checker],
+ [AS_HELP_STRING([--enable-naked-pointers-checker],
+ [enable the naked pointers checker])])
AC_ARG_ENABLE([cfi],
[AS_HELP_STRING([--disable-cfi],
[0],
[with_profinfo=false
profinfo_width=0],
- [[[1-9]]|1[[0-9]]|2[[0-1]]],
+ [[[1-9]]|[[1-2]][[0-9]]|3[[0-1]]],
[with_profinfo=true
profinfo_width="$enable_reserved_header_bits"],
[AC_MSG_ERROR([invalid argument to --enable-reserved-header-bits])])])
[AS_HELP_STRING([--disable-stdlib-manpages],
[do not build or install the library man pages])])
+AC_ARG_ENABLE([warn-error],
+ [AS_HELP_STRING([--enable-warn-error],
+ [treat C compiler warnings as errors])])
+
AC_ARG_VAR([WINDOWS_UNICODE_MODE],
[how to handle Unicode under Windows: ansi, compatible])
# User-specified LD still takes precedence.
AC_CHECK_TOOLS([LD],[ld link])
# libtool expects host_os=mingw for native Windows
+# Also, it has been observed that, on some platforms (e.g. msvc) LT_INIT
+# alters the CFLAGS variable, so we save its value before calling the macro
+# and restore it after the call
old_host_os=$host_os
AS_IF([test x"$host_os" = "xwindows"],[host_os=mingw])
+saved_CFLAGS="$CFLAGS"
LT_INIT
+CFLAGS="$saved_CFLAGS"
host_os=$old_host_os
+AS_CASE([$host],
+ [sparc-sun-solaris*],
+ [DEP_CC="false"],
+ [*-pc-windows],
+ [AC_CHECK_TOOLS(
+ [DEP_CC],
+ [$DEP_CC gcc cc x86_64-w64-mingw32-gcc i686-w64-mingw32-gcc],
+ [false])],
+ [DEP_CC="$CC"])
+
+AS_CASE([$enable_dependency_generation],
+ [yes],
+ [AS_IF([test "$DEP_CC" = "false"],
+ [AC_MSG_ERROR(m4_normalize([The MSVC ports cannot generate dependency
+ information. Install gcc (or another CC-like compiler)]))],
+ [compute_deps=true])],
+ [no], [compute_deps=false],
+ [AS_IF([test -e .git],
+ [AS_IF([test "$DEP_CC" = "false"],
+ [compute_deps=false],
+ [compute_deps=true])],
+ [compute_deps=false])])
+
# Extracting information from libtool's configuration
AS_IF([test -n "$RANLIB" ],
[RANLIBCMD="$RANLIB"],
AS_CASE([$ocaml_cv_cc_vendor],
[xlc-*],
[CPP="$CC -E -qnoppline"], # suppress incompatible XLC line directives
+ [sunc-*],
+ [CPP="$CC -E -Qn"], # suppress generation of Sun PRO ident string
[msvc-*],
[CPP="$CC -nologo -EP"])
AS_CASE([$ocaml_cv_cc_vendor],
[xlc-*],
- [outputobj='-o $(EMPTY)'; gcc_warnings="-qflag=i:i"], # all warnings enabled
+ [outputobj='-o $(EMPTY)'
+ warn_error_flag=''
+ cc_warnings='-qflag=i:i'], # all warnings enabled
+ [sunc-*],
+ [outputobj='-o $(EMPTY)'; cc_warnings=""],
[msvc-*],
- [outputobj=-Fo; gcc_warnings=""],
+ [outputobj='-Fo'
+ warn_error_flag='-WX'
+ cc_warnings=''],
[outputobj='-o $(EMPTY)'
- gcc_warnings='-Wall -Wdeclaration-after-statement'
- AS_CASE([AC_PACKAGE_VERSION],
- [*+dev*],
- [gcc_warnings="$gcc_warnings -Werror"])
- ])
+ warn_error_flag='-Werror'
+ cc_warnings='-Wall -Wdeclaration-after-statement'])
+
+AS_CASE([$enable_warn_error,AC_PACKAGE_VERSION],
+ [yes,*|,*+dev*],
+ [cc_warnings="$cc_warnings $warn_error_flag"])
# We select high optimization levels, provided we can turn off:
# - strict type-based aliasing analysis (too risky for the OCaml runtime)
[AC_MSG_ERROR(m4_normalize([This version of Mingw GCC is too old.
Please use GCC version 5 or above.]))],
[gcc-*],
- [internal_cflags="-Wno-unused $gcc_warnings \
+ [internal_cflags="-Wno-unused $cc_warnings \
-fexcess-precision=standard"
# TODO: see whether the code can be fixed to avoid -Wno-unused
common_cflags="-O2 -fno-strict-aliasing -fwrapv -mms-bitfields"
[AS_CASE([$ocaml_cv_cc_vendor],
[clang-*],
[common_cflags="-O2 -fno-strict-aliasing -fwrapv";
- internal_cflags="$gcc_warnings -fno-common"],
+ internal_cflags="$cc_warnings -fno-common"],
[gcc-[[012]]-*],
# Some versions known to miscompile OCaml, e,g, 2.7.2.1, some 2.96.
# Plus: C99 support unknown.
Reducing optimization level."]));
AC_MSG_WARN([Consider using GCC version 4.2 or above.]);
common_cflags="-std=gnu99 -O";
- internal_cflags="$gcc_warnings"],
+ internal_cflags="$cc_warnings"],
[gcc-4-[[234]]],
# No -fexcess-precision option before GCC 4.5
[common_cflags="-std=gnu99 -O2 -fno-strict-aliasing -fwrapv \
-fno-builtin-memcmp";
- internal_cflags="$gcc_warnings"],
+ internal_cflags="$cc_warnings"],
[gcc-4-*],
[common_cflags="-std=gnu99 -O2 -fno-strict-aliasing -fwrapv \
-fno-builtin-memcmp";
- internal_cflags="$gcc_warnings -fexcess-precision=standard"],
+ internal_cflags="$cc_warnings -fexcess-precision=standard"],
[gcc-*],
[common_cflags="-O2 -fno-strict-aliasing -fwrapv";
- internal_cflags="$gcc_warnings -fno-common \
+ internal_cflags="$cc_warnings -fno-common \
-fexcess-precision=standard"],
[msvc-*],
- [common_cflags="-nologo -O2 -Gy- -MD"
+ [common_cflags="-nologo -O2 -Gy- -MD $cc_warnings"
common_cppflags="-D_CRT_SECURE_NO_DEPRECATE"
internal_cppflags='-DUNICODE -D_UNICODE'
internal_cppflags="$internal_cppflags -DWINDOWS_UNICODE="
internal_cppflags="${internal_cppflags}\$(WINDOWS_UNICODE)"],
[xlc-*],
- [common_cflags="-O5 -qtune=balanced -qnoipa -qinline $CFLAGS";
- internal_cflags="$gcc_warnings"],
+ [common_cflags="-O5 -qtune=balanced -qnoipa -qinline";
+ internal_cflags="$cc_warnings"],
+ [sunc-*], # Optimization should be >= O4 to inline functions
+ # and prevent unresolved externals
+ [common_cflags="-O4 -xc99=all -D_XPG6 $CFLAGS";
+ internal_cflags="$cc_warnings"],
[common_cflags="-O"])])
internal_cppflags="-DCAML_NAME_SPACE $internal_cppflags"
[*,*-*-mingw32],
[AS_IF([$with_sharedlibs],
[AS_CASE([$host],
- [i686-*-*], [flexdll_chain="mingw"],
+ [i686-*-*], [flexdll_chain="mingw"; oc_dll_ldflags="-static-libgcc"],
[x86_64-*-*], [flexdll_chain="mingw64"])
flexlink="flexlink -chain $flexdll_chain -merge-manifest -stack 16777216"
flexdir=`$flexlink -where | tr -d '\015'`
mkexedebugflag="-link -g"])
ostype="Win32"
toolchain="mingw"
- mkexe='$(MKEXE_ANSI) $(if $(OC_LDFLAGS),-link "$(OC_LDFLAGS)")'
+ mkexe='$(FLEXLINK) -exe $(if $(OC_LDFLAGS),-link "$(OC_LDFLAGS)")'
oc_ldflags='-municode'
SO="dll"],
[*,*-pc-windows],
[toolchain=msvc
ostype="Win32"
- mkexe='$(MKEXE_ANSI) $(if $(OC_LDFLAGS),-link "$(OC_LDFLAGS)")'
+ mkexe='$(FLEXLINK) -exe $(if $(OC_LDFLAGS),-link "$(OC_LDFLAGS)")'
oc_ldflags='/ENTRY:wmainCRTStartup'
AS_CASE([$host],
[i686-pc-windows], [flexdll_chain=msvc],
[mkexe="$mkexe "
oc_ldflags="-brtl -bexpfull"
AC_DEFINE([HAS_ARCH_CODE32], [1])],
+ [gcc*,powerpc-*-linux*],
+ [oc_ldflags="-mbss-plt"],
)
AC_CHECK_HEADER([math.h])
AC_CHECK_HEADERS([unistd.h],[AC_DEFINE([HAS_UNISTD])])
AC_CHECK_HEADER([stdint.h],[AC_DEFINE([HAS_STDINT_H])])
-AC_CHECK_HEADER([sys/shm.h],[AC_DEFINE([HAS_SYS_SHM_H])])
AC_CHECK_HEADER([dirent.h], [AC_DEFINE([HAS_DIRENT])], [],
[#include <sys/types.h>])
AC_C_BIGENDIAN(
[
- AC_DEFINE([ARCH_BIG_ENDIAN], [1]),
+ AC_DEFINE([ARCH_BIG_ENDIAN], [1])
[endianness="be"]
],
[endianness="le"],
[*-*-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],
[*-pc-windows],
[mksharedlib='$(FLEXLINK)'
mkmaindll="$flexlink -maindll"
shared_libraries_supported=true],
[powerpc-ibm-aix*],
- [AS_CASE([$CC],
+ [AS_CASE([$ocaml_cv_cc_vendor],
[xlc*],
[mksharedlib="$CC -qmkshrobj -G"
shared_libraries_supported=true])],
+ [*-*-solaris*],
+ [sharedlib_cflags="-fPIC"
+ mksharedlib="$CC -shared"
+ rpath="-Wl,-rpath,"
+ mksharedlibrpath="-Wl,-rpath,"
+ shared_libraries_supported=true],
[[*-*-linux*|*-*-freebsd[3-9]*|*-*-freebsd[1-9][0-9]*\
|*-*-openbsd*|*-*-netbsd*|*-*-dragonfly*|*-*-gnu*|*-*-haiku*]],
[sharedlib_cflags="-fPIC"
- mksharedlib="$CC -shared"
+ AS_CASE([$CC,$host],
+ [gcc*,powerpc-*-linux*], [mksharedlib="$CC -shared -mbss-plt"],
+ [mksharedlib="$CC -shared"])
oc_ldflags="$oc_ldflags -Wl,-E"
rpath="-Wl,-rpath,"
mksharedlibrpath="-Wl,-rpath,"
[[i[3456]86-*-linux*]], [natdynlink=true],
[[i[3456]86-*-gnu*]], [natdynlink=true],
[[x86_64-*-linux*]], [natdynlink=true],
+ [arm64-*-darwin*], [natdynlink=true],
+ [aarch64-*-darwin*], [natdynlink=true],
[x86_64-*-darwin*], [natdynlink=true],
[s390x*-*-linux*], [natdynlink=true],
[powerpc*-*-linux*], [natdynlink=true],
+ [x86_64-*-solaris*], [natdynlink=true],
[i686-*-kfreebsd*], [natdynlink=true],
[x86_64-*-kfreebsd*], [natdynlink=true],
[x86_64-*-dragonfly*], [natdynlink=true],
OCAML_CC_SUPPORTS_ALIGNED
+## Check whether __attribute__((optimize("tree-vectorize")))) is supported
+OCAML_CC_SUPPORTS_TREE_VECTORIZE
+
# Configure the native-code compiler
arch=none
[arch=amd64; system=gnu],
[x86_64-*-dragonfly*],
[arch=amd64; system=dragonfly],
+ [x86_64-*-solaris*],
+ [arch=amd64; system=solaris],
[x86_64-*-freebsd*],
[arch=amd64; system=freebsd],
[x86_64-*-netbsd*],
[arch=amd64; system=netbsd],
[x86_64-*-openbsd*],
[arch=amd64; system=openbsd],
+ [arm64-*-darwin*],
+ [arch=arm64; system=macosx],
+ [aarch64-*-darwin*],
+ [arch=arm64; system=macosx],
[x86_64-*-darwin*],
[arch=amd64; system=macosx],
[x86_64-*-mingw32],
)
AS_IF([test x"$enable_native_compiler" = "xno"],
- [arch=none; model=default; system=unknown; native_compiler=false
+ [native_compiler=false
AC_MSG_NOTICE([the native compiler is disabled])],
[native_compiler=true])
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'],
+ [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_CASE(["$arch,$CC,$system,$model"],
- [amd64,gcc*,macosx,*], [PACKLD='ld -r -arch x86_64 -o $(EMPTY)'],
- [amd64,gcc*,solaris,*], [PACKLD='ld -r -m elf_x86_64 -o $(EMPTY)'],
- [power,gcc*,elf,ppc], [PACKLD='ld -r -m elf32ppclinux -o $(EMPTY)'],
- [power,gcc*,elf,ppc64], [PACKLD='ld -r -m elf64ppc -o $(EMPTY)'],
- [power,gcc*,elf,ppc64le], [PACKLD='ld -r -m elf64lppc -o $(EMPTY)'],
+ AS_IF([test x"$CC" = "xcl"],
# For the Microsoft C compiler there must be no space at the end of the
# string.
- [*,cl,*,*], [PACKLD="link -lib -nologo $machine -out:"],
- [PACKLD="$DIRECT_LD -r -o \$(EMPTY)"])],
+ [PACKLD="link -lib -nologo $machine -out:"],
+ [PACKLD="$DIRECT_LD -r$PACKLD_FLAGS -o \$(EMPTY)"])],
[PACKLD="$PARTIALLD -o \$(EMPTY)"])
-AS_IF([test $arch != "none" && $arch64 ],
- [otherlibraries="$otherlibraries raw_spacetime_lib"])
-
# Disable PIE at link time when ocamlopt does not produce position-independent
# code and the system produces PIE executables by default and demands PIC
# object files to do so.
# One may want to check whether the user provided values first
# and only compute values if none has been provided
+AC_CHECK_TOOL([SYSTEM_AS],[as])
+
AS_CASE(["$arch,$system"],
[i386,win32],
[default_as="ml -nologo -coff -Cp -c -Fo"],
[default_as="${toolpref}as -arch x86_64"
default_aspp="${toolpref}gcc -arch x86_64 -c"])],
[amd64,solaris],
- [default_as="${toolpref}as --64"
- default_aspp="${toolpref}gcc -m64 -c"],
- [i386,solaris],
- [default_as="${toolpref}as"
- default_aspp="${toolpref}gcc -c"],
+ [AS_CASE([$ocaml_cv_cc_vendor],
+ [sunc-*],
+ [AS_IF([test x"$SYSTEM_AS" = "x"],
+ [AC_MSG_ERROR([GNU as assembler is required.])],
+ [default_as="${toolpref}as --64"
+ default_aspp="${toolpref}cc -m64 -c"])],
+ [gcc-*],
+ [AS_IF([test x"$SYSTEM_AS" = "x"],
+ [default_as="${toolpref}gcc -m64 -c"
+ default_aspp="${toolpref}gcc -m64 -c"],
+ [default_as="${toolpref}as --64"
+ default_aspp="${toolpref}gcc -m64 -c"])])],
[power,elf],
[AS_CASE([$model],
[ppc64le],
AS_IF([test -z "$ASPP"], [ASPP="$default_aspp"])
+# Utilities
+AC_CHECK_PROG([rlwrap],[rlwrap],[rlwrap])
+AS_CASE([$rlwrap,$system],
+ [rlwrap,win*|rlwrap,mingw*],
+ [AC_MSG_NOTICE([rlwrap doesn't work with native win32 - disabling])
+ rlwrap=''])
+
# Checks for library functions
## Check the semantics of signal handlers
AS_IF([test "x$enable_instrumented_runtime" != "xno" ],
[
AS_CASE([$host],
+ [sparc-sun-solaris*],
+ [instrumented_runtime=false],
[*-*-windows],
[instrumented_runtime=true],
[*-apple-darwin*], [
[*-*-haiku],
[cclibs="$cclibs -lnetwork"
sockets=true],
+ [*-*-solaris*],
+ [cclibs="$cclibs -lsocket -lnsl"
+ sockets=true],
[
AC_CHECK_FUNC([socket])
AC_CHECK_FUNC([socketpair])
AC_CHECK_FUNC([getcwd], [AC_DEFINE([HAS_GETCWD])])
+AC_CHECK_DECL([system], [AC_DEFINE([HAS_SYSTEM])], [], [[#include <stdlib.h>]])
+
## utime
## Note: this was defined in config/s-nt.h but the autoconf macros do not
# seem to detect it properly on Windows so we hardcode the definition
AC_CHECK_FUNC([pwrite], [AC_DEFINE([HAS_PWRITE])])
## -fdebug-prefix-map support by the C compiler
-AS_CASE([$CC,$host],
+AS_CASE([$ocaml_cv_cc_vendor,$host],
[*,*-*-mingw32], [cc_has_debug_prefix_map=false],
[*,*-pc-windows], [cc_has_debug_prefix_map=false],
[xlc*,powerpc-ibm-aix*], [cc_has_debug_prefix_map=false],
+ [sunc*,sparc-sun-*], [cc_has_debug_prefix_map=false],
[OCAML_CC_HAS_DEBUG_PREFIX_MAP])
## Does stat support nanosecond precision
AC_CHECK_FUNC([getauxval], [AC_DEFINE([HAS_GETAUXVAL])])
+## shmat
+AC_CHECK_HEADER([sys/shm.h],
+ [
+ AC_DEFINE([HAS_SYS_SHM_H])
+ AC_CHECK_FUNC([shmat], [AC_DEFINE([HAS_SHMAT])])
+ ])
+
## execvpe
AC_CHECK_FUNC([execvpe], [AC_DEFINE([HAS_EXECVPE])])
+## posix_spawn
+
+AC_CHECK_HEADER([spawn.h],
+ [AC_CHECK_FUNC([posix_spawn],
+ [AC_CHECK_FUNC([posix_spawnp], [AC_DEFINE([HAS_POSIX_SPAWN])])])])
+
## ffs or _BitScanForward
AC_CHECK_FUNC([ffs], [AC_DEFINE([HAS_FFS])])
[systhread_support=true
otherlibraries="$otherlibraries systhreads"
AS_CASE([$host],
- [*-*-solaris*], [pthread_link="-lpthread -lposix4"],
[*-*-haiku*], [pthread_link=""],
+ [*-*-android*], [pthread_link=""],
[pthread_link="-lpthread"])
common_cppflags="$common_cppflags -D_REENTRANT"
AC_MSG_NOTICE([the POSIX threads library is supported])
[systhread_support=false
AC_MSG_NOTICE([the POSIX threads library is not supported])])])])])
-## BFD (Binary File Description) library
-
-bfd_cppflags=""
-bfd_ldflags=""
-bfd_ldlibs=""
-
-AS_IF([test x"$with_bfd" != "xno"],
- [bfd_available=false
- AS_CASE([$host],
- [x86_64-*-darwin*],
- [AS_IF([test -z "$BFD_INCLUDE_DIR"],
- [BFD_INCLUDE_DIR="/opt/local/include"])
- AS_IF([test -z "$BFD_LIB_DIR"],
- [BFD_LIB_DIR="/opt/local/lib"])],
- [*-*-openbsd*|*-*-freebsd*],
- [AS_IF([test -z "$BFD_INCLUDE_DIR"],
- [BFD_INCLUDE_DIR="/usr/local/include"])
- AS_IF([test -z "$BFD_LIB_DIR"],
- [BFD_LIB_DIR="/usr/local/lib"])])
- AS_IF([test -n "$BFD_INCLUDE_DIR"],
- [bfd_cppflags="-I$BFD_INCLUDE_DIR"])
- AS_IF([test -n "$BFD_LIB_DIR"],
- [bfd_ldflags="-L$BFD_LIB_DIR"])
- SAVED_CPPFLAGS="$CPPFLAGS"
- SAVED_LDFLAGS="$LDFLAGS"
- CPPFLAGS="$CPPFLAGS $bfd_cppflags"
- LDFLAGS="$LDFLAGS $bfd_ldflags"
- AC_CHECK_HEADER([bfd.h],
- [bfd_ldlibs=""
- AC_CHECK_LIB([bfd], [bfd_openr], [bfd_ldlibs="-lbfd"])
- AS_IF([test -z "$bfd_ldlibs"],
- [unset ac_cv_lib_bfd_bfd_openr
- AC_CHECK_LIB([bfd], [bfd_openr],
- [bfd_ldlibs="-lbfd $DLLIBS"], [], [$DLLIBS])])
- AS_IF([test -z "$bfd_ldlibs"],
- [unset ac_cv_lib_bfd_bfd_openr
- AC_CHECK_LIB([bfd], [bfd_openr],
- [bfd_ldlibs="-lbfd $DLLIBS -liberty"], [], [$DLLIBS -liberty])])
- AS_IF([test -z "$bfd_ldlibs"],
- [unset ac_cv_lib_bfd_bfd_openr
- AC_CHECK_LIB([bfd], [bfd_openr],
- [bfd_ldlibs="-lbfd $DLLIBS -liberty -lz"], [], [$DLLIBS -liberty -lz])])
- AS_IF([test -z "$bfd_ldlibs"],
- [unset ac_cv_lib_bfd_bfd_openr
- AC_CHECK_LIB([bfd], [bfd_openr],
- [bfd_ldlibs="-lbfd $DLLIBS -liberty -lz -lintl"], [],
- [$DLLIBS -liberty -lz -lintl])])
- AS_IF([test -n "$bfd_ldlibs"],
- [bfd_available=true
- AC_DEFINE([HAS_LIBBFD])])])
- AS_IF([! $bfd_available],
- [AS_IF([test x"$with_bfd" = "xyes"],
- [AC_MSG_ERROR([BFD library support requested but not available])],
- [bfd_cppflags=""
- bfd_ldflags=""
- AC_MSG_NOTICE(m4_normalize([
- BFD library not found, 'ocamlobjinfo' will be unable to display
- info on .cmxs files.
- ]))])])
- LDFLAGS="$SAVED_LDFLAGS"
- CPP_FLAGS="$SAVED_CPPFLAGS"],
- [AC_MSG_NOTICE(m4_normalize([
- Support for the BFD (Binary File Description) library disabled,
- 'ocamlobjinfo' will be unable to display info on .cmxs files.
- ]))])
-
## Does the assembler support debug prefix map and CFI directives
as_has_debug_prefix_map=false
asm_cfi_supported=false
## No naked pointers
AS_IF([test x"$enable_naked_pointers" = "xno" ],
- [AC_DEFINE([NO_NAKED_POINTERS])])
+ [naked_pointers=false
+ AC_DEFINE([NO_NAKED_POINTERS])],
+ [naked_pointers=true])
+
+AS_IF([test x"$enable_naked_pointers_checker" = "xyes" ],
+ [AS_IF([test x"$enable_naked_pointers" = "xno" ],
+ [AC_MSG_ERROR(m4_normalize([
+ --enable-naked-pointers-checker and --disable-naked-pointers
+ are incompatible]))])
+ AS_CASE(["$arch","$system"],
+ [amd64,linux|amd64,macosx \
+ |amd64,openbsd|amd64,win64 \
+ |amd64,freebsd|amd64,solaris],
+ [naked_pointers_checker=true
+ AC_DEFINE([NAKED_POINTERS_CHECKER])],
+ [*],
+ [AC_MSG_ERROR([naked pointers checker not supported on this platform])]
+ )],
+ [naked_pointers_checker=false])
## Check for mmap support for huge pages and contiguous heap
OCAML_MMAP_SUPPORTS_HUGE_PAGES
-# Spacetime profiling, including libunwind detection
-
-# The number of bits used for profiling information is configurable here.
-# The more bits used for profiling, the smaller will be Max_wosize.
-# Note that PROFINFO_WIDTH must still be defined even if not configuring
-# for Spacetime (see comment in runtime/caml/mlvalues.h on [Profinfo_hd]).
-AC_MSG_CHECKING([whether to build spacetime])
-AS_IF([test x"$enable_spacetime" != "xyes" ],
- [spacetime=false
- call_counts=true # as in original script but should probably be false
- libunwind_available=false
- libunwind_include_flags=
- libunwind_link_flags=
- AC_MSG_RESULT([no])],
- [AS_CASE([$arch],
- [amd64], [spacetime_supported=true],
- [spacetime_supported=false])
- AS_IF([$spacetime_supported],
- [AC_MSG_RESULT([yes])
- spacetime=true
- profinfo=true
- profinfo_width=26
- AC_DEFINE([WITH_SPACETIME])
- AS_IF([test x"$enable_call_counts" != "xno"],
- [call_counts=true
- AC_DEFINE([ENABLE_CALL_COUNTS])],
- [call_counts=false])
- AC_MSG_CHECKING([whether to use libunwind])
- AS_IF([test x"$with_libunwind" = "xno"],
- [AC_MSG_RESULT([disabled])],
- [AS_IF([test x"$with_libunwind" = "x"],
- [libunwind_requested=false
- AC_MSG_RESULT([if available])],
- [libunwind_requested=true
- AC_MSG_RESULT([requested])
- AS_IF([test x"$with_libunwind" != "xyes"],
- [AS_IF([test x"$LIBUNWIND_INCLUDE_DIR" = "x"],
- [LIBUNWIND_INCLUDE_DIR="$with_libunwind/include"])
- AS_IF([test x"$LIBUNWIND_LIB_DIR" = "x"],
- [LIBUNWIND_LIB_DIR="$with_libunwind/lib"])
- ])
- ])
- AS_IF([test "$system" = "macosx"],
- [AS_IF([test x"$LIBUNWIND_INCLUDE_DIR" != x -o \
- x"$LIBUNWIND_LIB_DIR" != x],
- [AC_MSG_WARN(m4_normalize([
- On MacOSX, specifying paths for libunwind headers or libraries
- is strongly discouraged. It is recommended to rely on the
- defaults provided by the configure script
- ]))])])
-
- AS_IF([test x"$LIBUNWIND_INCLUDE_DIR" != x],
- [libunwind_include_flags="-I$LIBUNWIND_INCLUDE_DIR"],
- [libunwind_include_flags=""])
-
- AS_CASE(["$system"],
- ["macosx"], [libunwind_link_flags="-framework System"],
- [libunwind_link_flags="-lunwind -lunwind-x86_64"])
-
- AS_IF([test x"$LIBUNWIND_LIB_DIR" != x],
- [libunwind_link_flags="-L$LIBUNWIND_LIB_DIR $libunwind_link_flags"])
-
- OCAML_CHECK_LIBUNWIND
-
- AS_IF([$libunwind_requested && ! $libunwind_available],
- [AC_MSG_ERROR([libunwind was requested but can not be found])])
-
- # We need unwinding information at runtime, but since we use
- # -no_compact_unwind, we also need -keep_dwarf_unwind otherwise
- # the OS X linker will chuck away the DWARF-like (.eh_frame)
- # information. (Older versions of OS X don't provide this.)
-
- AS_IF([$libunwind_available && test x"$system" = "xmacosx"],
- [extra_flags="-Wl,-keep_dwarf_unwind"
- mkexe="$mkexe $extra_flags"
- mksharedlib="$mksharedlib $extra_flags"])])
- ],
- [AS_IF([test x"$enable_spacetime" = "xyes"],
- [AC_MSG_RESULT([requested but not supported])
- AC_MSG_ERROR([exiting])],
- [AC_MSG_RESULT([no])])
- ])
- ])
-
AC_DEFINE_UNQUOTED([PROFINFO_WIDTH], [$profinfo_width])
AS_IF([$profinfo], [AC_DEFINE([WITH_PROFINFO])])
oc_cflags="$common_cflags $internal_cflags"
oc_cppflags="$common_cppflags $internal_cppflags"
-ocamlc_cflags="$common_cflags $sharedlib_cflags"
-ocamlc_cppflags="$common_cppflags"
+ocamlc_cflags="$common_cflags $sharedlib_cflags \$(CFLAGS)"
+ocamlc_cppflags="$common_cppflags \$(CPPFLAGS)"
cclibs="$cclibs $mathlib"
AS_CASE([$host],
AS_CASE([$host],
[*-*-mingw32|*-pc-windows],
- [max_testsuite_dir_retries=1
- AS_CASE([$WINDOWS_UNICODE_MODE],
+ [AS_CASE([$WINDOWS_UNICODE_MODE],
[ansi],
[windows_unicode=0],
[compatible|""],
[windows_unicode=1],
[AC_MSG_ERROR([unexpected windows unicode mode])])],
- [max_testsuite_dir_retries=0
- windows_unicode=0])
+ [windows_unicode=0])
# Define flexlink chain and flags correctly for the different Windows ports
AS_CASE([$host],
[AC_DEFINE([HAS_BROKEN_PRINTF])
AC_DEFINE([HAS_STRERROR])
AC_DEFINE([HAS_IPV6])
- AC_DEFINE([HAS_NICE])])
+ AC_DEFINE([HAS_NICE])],
+ [*-*-solaris*],
+ # This is required as otherwise floats are printed
+ # as "Infinity" and "Inf" instead of the expected "inf"
+ [AC_DEFINE([HAS_BROKEN_PRINTF])])
AS_IF([test x"$enable_stdlib_manpages" != "xno"],
[stdlib_manpages=true],[stdlib_manpages=false])
ROOTDIR = ..
--include $(ROOTDIR)/Makefile.config
--include $(ROOTDIR)/Makefile.common
+include $(ROOTDIR)/Makefile.common
include $(ROOTDIR)/Makefile.best_binaries
DYNLINKDIR=$(ROOTDIR)/otherlibs/dynlink
COMPFLAGS=$(INCLUDES) -absname -w +a-4-9-41-42-44-45-48 -warn-error A \
-safe-string -strict-sequence -strict-formats
LINKFLAGS=-linkall -I $(UNIXDIR) -I $(DYNLINKDIR)
-YACCFLAGS=
CAMLLEX=$(BEST_OCAMLLEX)
CAMLDEP=$(BEST_OCAMLDEP)
DEPFLAGS=-slash
$(CAMLC) $(LINKFLAGS) -o $@ -linkall $^
install:
- $(INSTALL_PROG) ocamldebug$(EXE) "$(INSTALL_BINDIR)/ocamldebug$(EXE)"
+ $(INSTALL_PROG) ocamldebug$(EXE) "$(INSTALL_BINDIR)"
clean::
rm -f ocamldebug ocamldebug.exe
let (k, l) =
list_truncate2 (checkpoint_count - List.length accepted) rejected
in
- (List.merge (fun {c_time = t1} {c_time = t2} -> compare t2 t1) accepted k,
+ (List.merge (fun t1 t2 -> compare t2.c_time t1.c_time) accepted k,
l)
(* Clean the checkpoint list. *)
open Clflags
+exception Exit_with_status of int
+
let output_prefix name =
let oname =
match !output_name with
print_string Config.version; print_newline();
print_string "Standard library directory: ";
print_string Config.standard_library; print_newline();
- exit 0
+ raise (Exit_with_status 0)
let print_version_string () =
- print_string Config.version; print_newline(); exit 0
+ print_string Config.version; print_newline();
+ raise (Exit_with_status 0)
let print_standard_library () =
- print_string Config.standard_library; print_newline(); exit 0
+ print_string Config.standard_library; print_newline();
+ raise (Exit_with_status 0)
let fatal err =
prerr_endline err;
- exit 2
+ raise (Exit_with_status 2)
let extract_output = function
| Some s -> s
"bad value %s for %s" s name;
false
+let decode_compiler_pass ppf v ~name ~filter =
+ let module P = Clflags.Compiler_pass in
+ let passes = P.available_pass_names ~filter ~native:!native_code in
+ begin match List.find_opt (String.equal v) passes with
+ | None ->
+ Printf.ksprintf (print_error ppf)
+ "bad value %s for option \"%s\" (expected one of: %s)"
+ v name (String.concat ", " passes);
+ None
+ | Some v -> P.of_string v
+ end
+
+let set_compiler_pass ppf ~name v flag ~filter =
+ match decode_compiler_pass ppf v ~name ~filter with
+ | None -> ()
+ | Some pass ->
+ match !flag with
+ | None -> flag := Some pass
+ | Some p ->
+ if not (p = pass) then begin
+ Printf.ksprintf (print_error ppf)
+ "Please specify at most one %s <pass>." name
+ end
+
(* 'can-discard=' specifies which arguments can be discarded without warning
because they are not understood by some versions of OCaml. *)
let can_discard = ref []
profile_columns := if check_bool ppf name v then if_on else []
| "stop-after" ->
- let module P = Clflags.Compiler_pass in
- let passes = P.available_pass_names ~native:!native_code in
- begin match List.find_opt (String.equal v) passes with
- | None ->
- Printf.ksprintf (print_error ppf)
- "bad value %s for option \"stop-after\" (expected one of: %s)"
- v (String.concat ", " passes)
- | Some v ->
- let pass = Option.get (P.of_string v) in
- Clflags.stop_after := Some pass
+ set_compiler_pass ppf v ~name Clflags.stop_after ~filter:(fun _ -> true)
+
+ | "save-ir-after" ->
+ if !native_code then begin
+ let filter = Clflags.Compiler_pass.can_save_ir_after in
+ match decode_compiler_pass ppf v ~name ~filter with
+ | None -> ()
+ | Some pass -> set_save_ir_after pass true
end
+
| _ ->
if not (List.mem name !can_discard) then begin
can_discard := name :: !can_discard;
name
end
+
let read_OCAMLPARAM ppf position =
try
let s = Sys.getenv "OCAMLPARAM" in
- let (before, after) =
- try
- parse_args s
- with SyntaxError s ->
- print_error ppf s;
- [],[]
- in
- List.iter (fun (name, v) -> read_one_param ppf position name v)
- (match position with
- Before_args -> before
- | Before_compile _ | Before_link -> after)
+ if s <> "" then
+ let (before, after) =
+ try
+ parse_args s
+ with SyntaxError s ->
+ print_error ppf s;
+ [],[]
+ in
+ List.iter (fun (name, v) -> read_one_param ppf position name v)
+ (match position with
+ Before_args -> before
+ | Before_compile _ | Before_link -> after)
with Not_found -> ()
(* OCAMLPARAM passed as file *)
let process_action
(ppf, implementation, interface, ocaml_mod_ext, ocaml_lib_ext) action =
+ let impl ~start_from name =
+ readenv ppf (Before_compile name);
+ let opref = output_prefix name in
+ implementation ~start_from ~source_file:name ~output_prefix:opref;
+ objfiles := (opref ^ ocaml_mod_ext) :: !objfiles
+ in
match action with
| ProcessImplementation name ->
- readenv ppf (Before_compile name);
- let opref = output_prefix name in
- implementation ~source_file:name ~output_prefix:opref;
- objfiles := (opref ^ ocaml_mod_ext) :: !objfiles
+ impl ~start_from:Compiler_pass.Parsing name
| ProcessInterface name ->
readenv ppf (Before_compile name);
let opref = output_prefix name in
| ProcessCFile name ->
readenv ppf (Before_compile name);
Location.input_name := name;
- if Ccomp.compile_file name <> 0 then exit 2;
+ if Ccomp.compile_file name <> 0 then raise (Exit_with_status 2);
ccobjs := c_object_of_filename name :: !ccobjs
| ProcessObjects names ->
ccobjs := names @ !ccobjs
else if not !native_code && Filename.check_suffix name Config.ext_dll then
dllibs := name :: !dllibs
else
- raise(Arg.Bad("don't know what to do with " ^ name))
+ match Compiler_pass.of_input_filename name with
+ | Some start_from ->
+ Location.input_name := name;
+ impl ~start_from name
+ | None -> raise(Arg.Bad("don't know what to do with " ^ name))
let action_of_file name =
(* *)
(**************************************************************************)
+exception Exit_with_status of int
+
val module_of_filename : string -> string -> string
val output_prefix : string -> string
val process_deferred_actions :
Format.formatter *
- (source_file:string -> output_prefix:string -> unit) *
+ (start_from:Clflags.Compiler_pass.t ->
+ source_file:string -> output_prefix:string -> unit) *
(* compile implementation *)
(source_file:string -> output_prefix:string -> unit) *
(* compile interface *)
(Emitcode.to_file oc i.module_name cmofile ~required_globals);
)
-let implementation ~source_file ~output_prefix =
+let implementation ~start_from ~source_file ~output_prefix =
let backend info typed =
let bytecode = to_bytecode info typed in
emit_bytecode info bytecode
in
with_info ~source_file ~output_prefix ~dump_ext:"cmo" @@ fun info ->
- Compile_common.implementation info ~backend
+ match (start_from : Clflags.Compiler_pass.t) with
+ | Parsing -> Compile_common.implementation info ~backend
+ | _ -> Misc.fatal_errorf "Cannot start from %s"
+ (Clflags.Compiler_pass.to_string start_from)
val interface:
source_file:string -> output_prefix:string -> unit
val implementation:
+ start_from:Clflags.Compiler_pass.t ->
source_file:string -> output_prefix:string -> unit
(** {2 Internal functions} **)
(**************************************************************************)
open Misc
-open Compenv
type info = {
source_file : string;
let with_info ~native ~tool_name ~source_file ~output_prefix ~dump_ext k =
Compmisc.init_path ();
- let module_name = module_of_filename source_file output_prefix in
+ let module_name = Compenv.module_of_filename source_file output_prefix in
Env.set_unit_name module_name;
let env = Compmisc.initial_env() in
let dump_file = String.concat "." [output_prefix; dump_ext] in
(* *)
(**************************************************************************)
-open Compenv
-
(* Initialize the search path.
[dir] is always searched first (default: the current directory),
then the directories specified with the -I option (in command-line order),
!Clflags.include_dirs
in
let dirs =
- !last_include_dirs @ dirs @ Config.flexdll_dirs @ !first_include_dirs
+ !Compenv.last_include_dirs @ dirs @ Config.flexdll_dirs @
+ !Compenv.first_include_dirs
in
let exp_dirs =
List.map (Misc.expand_directory Config.standard_library) dirs 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. *)
-(* *)
-(**************************************************************************)
-
-open Clflags
-open Compenv
-
-let usage = "Usage: ocamlc <options> <files>\nOptions are:"
-
-(* Error messages to standard error formatter *)
-let ppf = Format.err_formatter
-
-module Options = Main_args.Make_bytecomp_options (Main_args.Default.Main)
-
-let main () =
- Clflags.add_arguments __LOC__ Options.list;
- Clflags.add_arguments __LOC__
- ["-depend", Arg.Unit Makedepend.main_from_option,
- "<options> Compute dependencies (use 'ocamlc -depend -help' for details)"];
- try
- readenv ppf Before_args;
- Clflags.parse_arguments anonymous usage;
- Compmisc.read_clflags_from_env ();
- if !Clflags.plugin then
- fatal "-plugin is only supported up to OCaml 4.08.0";
- begin try
- Compenv.process_deferred_actions
- (ppf,
- Compile.implementation,
- Compile.interface,
- ".cmo",
- ".cma");
- with Arg.Bad msg ->
- begin
- prerr_endline msg;
- Clflags.print_arguments usage;
- exit 2
- end
- end;
- readenv ppf Before_link;
- if
- List.length
- (List.filter (fun x -> !x)
- [make_archive;make_package;stop_early;output_c_object])
- > 1
- then begin
- let module P = Clflags.Compiler_pass in
- match !stop_after with
- | None ->
- fatal "Please specify at most one of -pack, -a, -c, -output-obj";
- | Some ((P.Parsing | P.Typing) as p) ->
- assert (P.is_compilation_pass p);
- Printf.ksprintf fatal
- "Options -i and -stop-after (%s) \
- are incompatible with -pack, -a, -output-obj"
- (String.concat "|"
- (Clflags.Compiler_pass.available_pass_names ~native:false))
- | Some P.Scheduling -> assert false (* native only *)
- end;
- if !make_archive then begin
- Compmisc.init_path ();
-
- Bytelibrarian.create_archive
- (Compenv.get_objfiles ~with_ocamlparam:false)
- (extract_output !output_name);
- Warnings.check_fatal ();
- end
- else if !make_package then begin
- Compmisc.init_path ();
- let extracted_output = extract_output !output_name in
- let revd = get_objfiles ~with_ocamlparam:false in
- Compmisc.with_ppf_dump ~file_prefix:extracted_output (fun ppf_dump ->
- Bytepackager.package_files ~ppf_dump (Compmisc.initial_env ())
- revd (extracted_output));
- Warnings.check_fatal ();
- end
- else if not !stop_early && !objfiles <> [] then begin
- let target =
- if !output_c_object && not !output_complete_executable then
- let s = extract_output !output_name in
- if (Filename.check_suffix s Config.ext_obj
- || Filename.check_suffix s Config.ext_dll
- || Filename.check_suffix s ".c")
- then s
- else
- fatal
- (Printf.sprintf
- "The extension of the output file must be .c, %s or %s"
- Config.ext_obj Config.ext_dll
- )
- else
- default_output !output_name
- in
- Compmisc.init_path ();
- Bytelink.link (get_objfiles ~with_ocamlparam:true) target;
- Warnings.check_fatal ();
- end;
- with x ->
- Location.report_exception ppf x;
- exit 2
-
let () =
- main ();
- Profile.print Format.std_formatter !Clflags.profile_columns;
- exit 0
+ exit (Maindriver.main Sys.argv Format.err_formatter)
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Damien Doligez, projet Moscova, INRIA Rocquencourt *)
-(* *)
-(* Copyright 2000 Institut National de Recherche en Informatique et *)
-(* en Automatique. *)
-(* *)
-(* All rights reserved. This file is distributed 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 "empty" file is here to speed up garbage collection in ocamlc.opt
-*)
;;
let mk_stop_after ~native f =
- "-stop-after",
- Arg.Symbol (Clflags.Compiler_pass.available_pass_names ~native, f),
+ let pass_names = Clflags.Compiler_pass.available_pass_names
+ ~filter:(fun _ -> true)
+ ~native
+ in
+ "-stop-after", Arg.Symbol (pass_names, f),
" Stop after the given compilation pass."
;;
+let mk_save_ir_after ~native f =
+ let pass_names =
+ Clflags.Compiler_pass.(available_pass_names
+ ~filter:can_save_ir_after
+ ~native)
+ in
+ "-save-ir-after", Arg.Symbol (pass_names, f),
+ " Save intermediate representation after the given compilation pass\
+ (may be specified more than once)."
+
let mk_dtypes f =
"-dtypes", Arg.Unit f, " (deprecated) same as -annot"
;;
val _afl_instrument : unit -> unit
val _afl_inst_ratio : int -> unit
val _function_sections : unit -> unit
+ val _save_ir_after : string -> unit
end;;
module type Opttop_options = sig
mk_g_opt F._g;
mk_function_sections F._function_sections;
mk_stop_after ~native:true F._stop_after;
+ mk_save_ir_after ~native:true F._save_ir_after;
mk_i F._i;
mk_I F._I;
mk_impl F._impl;
if not !after_rest then (after_rest := true; option ());
arg a
in
+ let rest_all a = option (); List.iter arg a in
match spec with
| Unit f -> Unit (fun a -> f a; option ())
| Bool f -> Bool (fun a -> f a; option_with_arg (string_of_bool a))
Tuple (loop ~name_opt hd :: List.map (loop ~name_opt:None) tl)
| Symbol (l, f) -> Symbol (l, (fun a -> f a; option_with_arg a))
| Rest f -> Rest (fun a -> f a; rest a)
+ | Rest_all f -> Rest_all (fun a -> f a; rest_all a)
| Expand f -> Expand f
in
loop
module Default = struct
open Clflags
- open Compenv
let set r () = r := true
let clear r () = r := false
let _unsafe_string = set unsafe_string
let _w s = Warnings.parse_options false s
- let anonymous = anonymous
+ let anonymous = Compenv.anonymous
end
let _error_style =
Misc.set_or_ignore error_style_reader.parse error_style
let _nopervasives = set nopervasives
- let _ppx s = first_ppx := (s :: (!first_ppx))
+ let _ppx s = Compenv.first_ppx := (s :: (!Compenv.first_ppx))
let _unsafe = set unsafe
let _warn_error s = Warnings.parse_options true s
let _warn_help = Warnings.help_warnings
let _binannot = set binary_annotations
let _c = set compile_only
let _cc s = c_compiler := (Some s)
- let _cclib s = defer (ProcessObjects (Misc.rev_split_words s))
- let _ccopt s = first_ccopts := (s :: (!first_ccopts))
+ let _cclib s = Compenv.defer (ProcessObjects (Misc.rev_split_words s))
+ let _ccopt s = Compenv.first_ccopts := (s :: (!Compenv.first_ccopts))
let _config = Misc.show_config_and_exit
let _config_var = Misc.show_config_variable_and_exit
let _dprofile () = profile_columns := Profile.all_columns
let _for_pack s = for_package := (Some s)
let _g = set debug
let _i = set print_types
- let _impl = impl
- let _intf = intf
+ let _impl = Compenv.impl
+ let _intf = Compenv.intf
let _intf_suffix s = Config.interface_suffix := s
let _keep_docs = set keep_docs
let _keep_locs = set keep_locs
| None -> stop_after := (Some pass)
| Some p ->
if not (p = pass) then
- fatal "Please specify at most one -stop-after <pass>."
+ Compenv.fatal "Please specify at most one -stop-after <pass>."
+ let _save_ir_after pass =
+ let module P = Compiler_pass in
+ match P.of_string pass with
+ | None -> () (* this should not occur as we use Arg.Symbol *)
+ | Some pass ->
+ set_save_ir_after pass true
let _thread = set use_threads
let _verbose = set verbose
- let _version () = print_version_string ()
- let _vnum () = print_version_string ()
- let _where () = print_standard_library ()
+ let _version () = Compenv.print_version_string ()
+ let _vnum () = Compenv.print_version_string ()
+ let _where () = Compenv.print_standard_library ()
let _with_runtime = set with_runtime
let _without_runtime = clear with_runtime
end
let print_version () =
Printf.printf "The OCaml toplevel, version %s\n" Sys.ocaml_version;
- exit 0;
+ raise (Compenv.Exit_with_status 0);
;;
let print_version_num () =
Printf.printf "%s\n" Sys.ocaml_version;
- exit 0;
+ raise (Compenv.Exit_with_status 0);
;;
let _args (_:string) = (* placeholder: wrap_expand Arg.read_arg *) [||]
let _afl_instrument = set afl_instrument
let _function_sections () =
assert Config.function_sections;
- first_ccopts := ("-ffunction-sections" :: (!first_ccopts));
+ Compenv.first_ccopts := ("-ffunction-sections" ::(!Compenv.first_ccopts));
function_sections := true
let _nodynlink = clear dlcode
let _output_complete_obj () =
set output_c_object (); set output_complete_object ()
let _output_obj = set output_c_object
let _p () =
- fatal
+ Compenv.fatal
"Profiling with \"gprof\" (option `-p') is only supported up to \
OCaml 4.08.0"
let _shared () = shared := true; dlcode := true
- let _v () = print_version_and_library "native-code compiler"
+ let _v () = Compenv.print_version_and_library "native-code compiler"
end
module Odoc_args = struct
let _custom = set custom_runtime
let _dcamlprimc = set keep_camlprimc_file
let _dinstr = set dump_instr
- let _dllib s = defer (ProcessDLLs (Misc.rev_split_words s))
+ let _dllib s = Compenv.defer (ProcessDLLs (Misc.rev_split_words s))
let _dllpath s = dllpaths := ((!dllpaths) @ [s])
let _make_runtime () =
custom_runtime := true; make_runtime := true; link_everything := true
let _output_obj () = output_c_object := true; custom_runtime := true
let _use_prims s = use_prims := s
let _use_runtime s = use_runtime := s
- let _v () = print_version_and_library "compiler"
- let _vmthread () = fatal vmthread_removed_message
+ let _v () = Compenv.print_version_and_library "compiler"
+ let _vmthread () = Compenv.fatal vmthread_removed_message
end
end
val _afl_instrument : unit -> unit
val _afl_inst_ratio : int -> unit
val _function_sections : unit -> unit
+ val _save_ir_after : string -> unit
end;;
module type Opttop_options = sig
--- /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. *)
+(* *)
+(**************************************************************************)
+
+open Clflags
+
+let usage = "Usage: ocamlc <options> <files>\nOptions are:"
+
+module Options = Main_args.Make_bytecomp_options (Main_args.Default.Main)
+
+let main argv ppf =
+ Clflags.add_arguments __LOC__ Options.list;
+ Clflags.add_arguments __LOC__
+ ["-depend", Arg.Unit Makedepend.main_from_option,
+ "<options> Compute dependencies (use 'ocamlc -depend -help' for details)"];
+ match
+ Compenv.readenv ppf Before_args;
+ Clflags.parse_arguments argv Compenv.anonymous usage;
+ Compmisc.read_clflags_from_env ();
+ if !Clflags.plugin then
+ Compenv.fatal "-plugin is only supported up to OCaml 4.08.0";
+ begin try
+ Compenv.process_deferred_actions
+ (ppf,
+ Compile.implementation,
+ Compile.interface,
+ ".cmo",
+ ".cma");
+ with Arg.Bad msg ->
+ begin
+ prerr_endline msg;
+ Clflags.print_arguments usage;
+ exit 2
+ end
+ end;
+ Compenv.readenv ppf Before_link;
+ if
+ List.length
+ (List.filter (fun x -> !x)
+ [make_archive;make_package;Compenv.stop_early;output_c_object])
+ > 1
+ then begin
+ let module P = Clflags.Compiler_pass in
+ match !stop_after with
+ | None ->
+ Compenv.fatal
+ "Please specify at most one of -pack, -a, -c, -output-obj";
+ | Some ((P.Parsing | P.Typing) as p) ->
+ assert (P.is_compilation_pass p);
+ Printf.ksprintf Compenv.fatal
+ "Options -i and -stop-after (%s) \
+ are incompatible with -pack, -a, -output-obj"
+ (String.concat "|"
+ (P.available_pass_names ~filter:(fun _ -> true) ~native:false))
+ | Some (P.Scheduling | P.Emit) -> assert false (* native only *)
+ end;
+ if !make_archive then begin
+ Compmisc.init_path ();
+
+ Bytelibrarian.create_archive
+ (Compenv.get_objfiles ~with_ocamlparam:false)
+ (Compenv.extract_output !output_name);
+ Warnings.check_fatal ();
+ end
+ else if !make_package then begin
+ Compmisc.init_path ();
+ let extracted_output = Compenv.extract_output !output_name in
+ let revd = Compenv.get_objfiles ~with_ocamlparam:false in
+ Compmisc.with_ppf_dump ~file_prefix:extracted_output (fun ppf_dump ->
+ Bytepackager.package_files ~ppf_dump (Compmisc.initial_env ())
+ revd (extracted_output));
+ Warnings.check_fatal ();
+ end
+ else if not !Compenv.stop_early && !objfiles <> [] then begin
+ let target =
+ if !output_c_object && not !output_complete_executable then
+ let s = Compenv.extract_output !output_name in
+ if (Filename.check_suffix s Config.ext_obj
+ || Filename.check_suffix s Config.ext_dll
+ || Filename.check_suffix s ".c")
+ then s
+ else
+ Compenv.fatal
+ (Printf.sprintf
+ "The extension of the output file must be .c, %s or %s"
+ Config.ext_obj Config.ext_dll
+ )
+ else
+ Compenv.default_output !output_name
+ in
+ Compmisc.init_path ();
+ Bytelink.link (Compenv.get_objfiles ~with_ocamlparam:true) target;
+ Warnings.check_fatal ();
+ end;
+ with
+ | exception (Compenv.Exit_with_status n) ->
+ n
+ | exception x ->
+ Location.report_exception ppf x;
+ 2
+ | () ->
+ Profile.print Format.std_formatter !Clflags.profile_columns;
+ 0
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Damien Doligez, projet Moscova, INRIA Rocquencourt *)
+(* *)
+(* Copyright 2000 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(* [main argv ppf] runs the compiler with arguments [argv], printing any
+ errors encountered to [ppf], and returns the exit code.
+
+ NB: Due to internal state in the compiler, calling [main] twice during
+ the same process is unsupported. *)
+val main : string array -> Format.formatter -> int
(* *)
(**************************************************************************)
-open Compenv
open Parsetree
module String = Misc.Stdlib.String
module_map := String.Map.add modname mm !module_map
;;
+(* Dependency processing *)
+
+type dep_arg =
+ | Map of Misc.filepath (* -map option *)
+ | Src of Misc.filepath * file_kind option (* -impl, -intf or anon arg *)
+
+let process_dep_arg = function
+ | Map file -> parse_map file
+ | Src (file, None) -> file_dependencies file
+ | Src (file, (Some file_kind)) -> file_dependencies_as file_kind file
+
+let process_dep_args dep_args = List.iter process_dep_arg dep_args
(* Entry point *)
exit 0;
;;
-let main () =
+
+let run_main argv =
+ let dep_args_rev : dep_arg list ref = ref [] in
+ let add_dep_arg f s = dep_args_rev := (f s) :: !dep_args_rev in
Clflags.classic := false;
Compenv.readenv ppf Before_args;
Clflags.reset_arguments (); (* reset arguments from ocamlc/ocamlopt *)
"-nocwd", Arg.Set nocwd,
" Do not add current working directory to \
the list of include directories";
- "-impl", Arg.String (file_dependencies_as ML),
+ "-impl", Arg.String (add_dep_arg (fun f -> Src (f, Some ML))),
"<f> Process <f> as a .ml file";
- "-intf", Arg.String (file_dependencies_as MLI),
+ "-intf", Arg.String (add_dep_arg (fun f -> Src (f, Some MLI))),
"<f> Process <f> as a .mli file";
- "-map", Arg.String parse_map,
+ "-map", Arg.String (add_dep_arg (fun f -> Map f)),
"<f> Read <f> and propagate delayed dependencies to following files";
"-ml-synonym", Arg.String(add_to_synonym_list ml_synonyms),
"<e> Consider <e> as a synonym of the .ml extension";
"<plugin> (no longer supported)";
"-pp", Arg.String(fun s -> Clflags.preprocessor := Some s),
"<cmd> Pipe sources through preprocessor <cmd>";
- "-ppx", Arg.String (add_to_list first_ppx),
+ "-ppx", Arg.String (add_to_list Compenv.first_ppx),
"<cmd> Pipe abstract syntax trees through preprocessor <cmd>";
"-shared", Arg.Set shared,
" Generate dependencies for native plugin files (.cmxs targets)";
Printf.sprintf "Usage: %s [options] <source files>\nOptions are:"
(Filename.basename Sys.argv.(0))
in
- Clflags.parse_arguments file_dependencies usage;
+ Clflags.parse_arguments argv (add_dep_arg (fun f -> Src (f, None))) usage;
+ process_dep_args (List.rev !dep_args_rev);
Compenv.readenv ppf Before_link;
if !sort_files then sort_files_by_dependencies !files
else List.iter print_file_dependencies (List.sort compare !files);
exit (if Error_occurred.get () then 2 else 0)
+let main () =
+ run_main Sys.argv
+
let main_from_option () =
if Sys.argv.(1) <> "-depend" then begin
Printf.eprintf
"Fatal error: argument -depend must be used as first argument.\n%!";
exit 2;
end;
- incr Arg.current;
- Sys.argv.(0) <- Sys.argv.(0) ^ " -depend";
- Sys.argv.(!Arg.current) <- Sys.argv.(0);
- main ()
+ let args =
+ Array.concat [ [| Sys.argv.(0) ^ " -depend" |];
+ Array.sub Sys.argv 2 (Array.length Sys.argv - 2) ] in
+ Sys.argv.(0) <- args.(0);
+ run_main args
~ppf_dump:i.ppf_dump;
Compilenv.save_unit_info (cmx i))
-let implementation ~backend ~source_file ~output_prefix =
+(* Emit assembly directly from Linear IR *)
+let emit i =
+ Compilenv.reset ?packname:!Clflags.for_package i.module_name;
+ Asmgen.compile_implementation_linear i.output_prefix ~progname:i.source_file
+
+let implementation ~backend ~start_from ~source_file ~output_prefix =
let backend info typed =
Compilenv.reset ?packname:!Clflags.for_package info.module_name;
if Config.flambda
else clambda info backend typed
in
with_info ~source_file ~output_prefix ~dump_ext:"cmx" @@ fun info ->
- Compile_common.implementation info ~backend
+ match (start_from:Clflags.Compiler_pass.t) with
+ | Parsing -> Compile_common.implementation info ~backend
+ | Emit -> emit info
+ | _ -> Misc.fatal_errorf "Cannot start from %s"
+ (Clflags.Compiler_pass.to_string start_from)
val implementation:
backend:(module Backend_intf.S)
+ -> start_from:Clflags.Compiler_pass.t
-> source_file:string -> output_prefix:string -> unit
(** {2 Internal functions} **)
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
-(* *)
-(* Copyright 1996 Institut National de Recherche en Informatique et *)
-(* en Automatique. *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-open Clflags
-open Compenv
-
-module Backend = struct
- (* See backend_intf.mli. *)
-
- let symbol_for_global' = Compilenv.symbol_for_global'
- let closure_symbol = Compilenv.closure_symbol
-
- let really_import_approx = Import_approx.really_import_approx
- let import_symbol = Import_approx.import_symbol
-
- let size_int = Arch.size_int
- let big_endian = Arch.big_endian
-
- 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 usage = "Usage: ocamlopt <options> <files>\nOptions are:"
-
-module Options = Main_args.Make_optcomp_options (Main_args.Default.Optmain)
-let main () =
- native_code := true;
- let ppf = Format.err_formatter in
- try
- readenv ppf Before_args;
- Clflags.add_arguments __LOC__ (Arch.command_line_options @ Options.list);
- Clflags.add_arguments __LOC__
- ["-depend", Arg.Unit Makedepend.main_from_option,
- "<options> Compute dependencies \
- (use 'ocamlopt -depend -help' for details)"];
- Clflags.parse_arguments anonymous usage;
- Compmisc.read_clflags_from_env ();
- if !Clflags.plugin then
- fatal "-plugin is only supported up to OCaml 4.08.0";
- begin try
- Compenv.process_deferred_actions
- (ppf,
- Optcompile.implementation ~backend,
- Optcompile.interface,
- ".cmx",
- ".cmxa");
- with Arg.Bad msg ->
- begin
- prerr_endline msg;
- Clflags.print_arguments usage;
- exit 2
- end
- end;
- readenv ppf Before_link;
- if
- List.length (List.filter (fun x -> !x)
- [make_package; make_archive; shared;
- stop_early; output_c_object]) > 1
- then
- begin
- let module P = Clflags.Compiler_pass in
- match !stop_after with
- | None ->
- fatal "Please specify at most one of -pack, -a, -shared, -c, \
- -output-obj";
- | Some ((P.Parsing | P.Typing | P.Scheduling) as p) ->
- assert (P.is_compilation_pass p);
- Printf.ksprintf fatal
- "Options -i and -stop-after (%s) \
- are incompatible with -pack, -a, -shared, -output-obj"
- (String.concat "|"
- (Clflags.Compiler_pass.available_pass_names ~native:true))
- end;
- if !make_archive then begin
- Compmisc.init_path ();
- let target = extract_output !output_name in
- Asmlibrarian.create_archive
- (get_objfiles ~with_ocamlparam:false) target;
- Warnings.check_fatal ();
- end
- else if !make_package then begin
- Compmisc.init_path ();
- let target = extract_output !output_name in
- Compmisc.with_ppf_dump ~file_prefix:target (fun ppf_dump ->
- Asmpackager.package_files ~ppf_dump (Compmisc.initial_env ())
- (get_objfiles ~with_ocamlparam:false) target ~backend);
- Warnings.check_fatal ();
- end
- else if !shared then begin
- Compmisc.init_path ();
- let target = extract_output !output_name in
- Compmisc.with_ppf_dump ~file_prefix:target (fun ppf_dump ->
- Asmlink.link_shared ~ppf_dump
- (get_objfiles ~with_ocamlparam:false) target);
- Warnings.check_fatal ();
- end
- else if not !stop_early && !objfiles <> [] then begin
- let target =
- if !output_c_object then
- let s = extract_output !output_name in
- if (Filename.check_suffix s Config.ext_obj
- || Filename.check_suffix s Config.ext_dll)
- then s
- else
- fatal
- (Printf.sprintf
- "The extension of the output file must be %s or %s"
- Config.ext_obj Config.ext_dll
- )
- else
- default_output !output_name
- in
- Compmisc.init_path ();
- Compmisc.with_ppf_dump ~file_prefix:target (fun ppf_dump ->
- Asmlink.link ~ppf_dump (get_objfiles ~with_ocamlparam:true) target);
- Warnings.check_fatal ();
- end;
- with x ->
- Location.report_exception ppf x;
- exit 2
-
let () =
- main ();
- Profile.print Format.std_formatter !Clflags.profile_columns;
- exit 0
+ exit (Optmaindriver.main Sys.argv Format.err_formatter)
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Damien Doligez, projet Moscova, INRIA Rocquencourt *)
-(* *)
-(* Copyright 2000 Institut National de Recherche en Informatique et *)
-(* en Automatique. *)
-(* *)
-(* All rights reserved. This file is distributed 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 "empty" file is here to speed up garbage collection in ocamlopt.opt
-*)
--- /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. *)
+(* *)
+(**************************************************************************)
+
+open Clflags
+
+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 usage = "Usage: ocamlopt <options> <files>\nOptions are:"
+
+module Options = Main_args.Make_optcomp_options (Main_args.Default.Optmain)
+let main argv ppf =
+ native_code := true;
+ match
+ Compenv.readenv ppf Before_args;
+ Clflags.add_arguments __LOC__ (Arch.command_line_options @ Options.list);
+ Clflags.add_arguments __LOC__
+ ["-depend", Arg.Unit Makedepend.main_from_option,
+ "<options> Compute dependencies \
+ (use 'ocamlopt -depend -help' for details)"];
+ Clflags.parse_arguments argv Compenv.anonymous usage;
+ Compmisc.read_clflags_from_env ();
+ if !Clflags.plugin then
+ Compenv.fatal "-plugin is only supported up to OCaml 4.08.0";
+ begin try
+ Compenv.process_deferred_actions
+ (ppf,
+ Optcompile.implementation ~backend,
+ Optcompile.interface,
+ ".cmx",
+ ".cmxa");
+ with Arg.Bad msg ->
+ begin
+ prerr_endline msg;
+ Clflags.print_arguments usage;
+ exit 2
+ end
+ end;
+ Compenv.readenv ppf Before_link;
+ if
+ List.length (List.filter (fun x -> !x)
+ [make_package; make_archive; shared;
+ Compenv.stop_early; output_c_object]) > 1
+ then
+ begin
+ let module P = Clflags.Compiler_pass in
+ match !stop_after with
+ | None ->
+ Compenv.fatal "Please specify at most one of -pack, -a, -shared, -c, \
+ -output-obj";
+ | Some ((P.Parsing | P.Typing | P.Scheduling | P.Emit) as p) ->
+ assert (P.is_compilation_pass p);
+ Printf.ksprintf Compenv.fatal
+ "Options -i and -stop-after (%s) \
+ are incompatible with -pack, -a, -shared, -output-obj"
+ (String.concat "|"
+ (P.available_pass_names ~filter:(fun _ -> true) ~native:true))
+ end;
+ if !make_archive then begin
+ Compmisc.init_path ();
+ let target = Compenv.extract_output !output_name in
+ Asmlibrarian.create_archive
+ (Compenv.get_objfiles ~with_ocamlparam:false) target;
+ Warnings.check_fatal ();
+ end
+ else if !make_package then begin
+ Compmisc.init_path ();
+ let target = Compenv.extract_output !output_name in
+ Compmisc.with_ppf_dump ~file_prefix:target (fun ppf_dump ->
+ Asmpackager.package_files ~ppf_dump (Compmisc.initial_env ())
+ (Compenv.get_objfiles ~with_ocamlparam:false) target ~backend);
+ Warnings.check_fatal ();
+ end
+ else if !shared then begin
+ Compmisc.init_path ();
+ let target = Compenv.extract_output !output_name in
+ Compmisc.with_ppf_dump ~file_prefix:target (fun ppf_dump ->
+ Asmlink.link_shared ~ppf_dump
+ (Compenv.get_objfiles ~with_ocamlparam:false) target);
+ Warnings.check_fatal ();
+ end
+ else if not !Compenv.stop_early && !objfiles <> [] then begin
+ let target =
+ if !output_c_object then
+ let s = Compenv.extract_output !output_name in
+ if (Filename.check_suffix s Config.ext_obj
+ || Filename.check_suffix s Config.ext_dll)
+ then s
+ else
+ Compenv.fatal
+ (Printf.sprintf
+ "The extension of the output file must be %s or %s"
+ Config.ext_obj Config.ext_dll
+ )
+ else
+ Compenv.default_output !output_name
+ in
+ Compmisc.init_path ();
+ Compmisc.with_ppf_dump ~file_prefix:target (fun ppf_dump ->
+ let objs = Compenv.get_objfiles ~with_ocamlparam:true in
+ Asmlink.link ~ppf_dump objs target);
+ Warnings.check_fatal ();
+ end;
+ with
+ | exception (Compenv.Exit_with_status n) ->
+ n
+ | exception x ->
+ Location.report_exception ppf x;
+ 2
+ | () ->
+ Profile.print Format.std_formatter !Clflags.profile_columns;
+ 0
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Damien Doligez, projet Moscova, INRIA Rocquencourt *)
+(* *)
+(* Copyright 2000 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(* [main argv ppf] runs the compiler with arguments [argv], printing any
+ errors encountered to [ppf], and returns the exit code.
+
+ NB: Due to internal state in the compiler, calling [main] twice during
+ the same process is unsupported. *)
+val main : string array -> Format.formatter -> int
Location.input_name := (input_value ic : string);
if !Clflags.unsafe then
Location.prerr_warning (Location.in_file !Location.input_name)
- Warnings.Unsafe_without_parsing;
+ Warnings.Unsafe_array_syntax_without_parsing;
let ast = (input_value ic : a) in
if !Clflags.all_ppx = [] then invariant_fun ast;
(* if all_ppx <> [], invariant_fun will be called by apply_rewriters *)
;; UTILS
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
+ targetint load_path int_replace_polymorphic_compare binutils local_store
;; PARSING
location longident docstrings syntaxerr ast_helper camlinternalMenhirLib
cmi_format persistent_env env type_immediacy
typedtree printtyped ctype printtyp includeclass mtype envaux includecore
tast_iterator tast_mapper cmt_format untypeast includemod
- typetexp printpat parmatch stypes typedecl typeopt rec_check typecore
+ typetexp patterns printpat parmatch stypes typedecl typeopt rec_check
+ typecore
typeclass typemod typedecl_variance typedecl_properties typedecl_immediacy
typedecl_unboxed typedecl_separability cmt2annot
; manual update: mli only files
CSE CSEgen
deadcode domainstate emit emitaux interf interval linear linearize linscan
liveness mach printcmm printlinear printmach proc reg reload reloadgen
- schedgen scheduling selectgen selection spacetime_profiling spill split
+ schedgen scheduling selectgen selection spill split
strmatch x86_ast x86_dsl x86_gas x86_masm x86_proc
;; asmcomp/debug/
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* Greta Yorsh, Jane Street Europe *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* Copyright 2019 Jane Street Group LLC *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(* Marshal and unmarshal a compilation unit in linear format *)
+type linear_item_info =
+ | Func of Linear.fundecl
+ | Data of Cmm.data_item list
+
+type linear_unit_info =
+ {
+ mutable unit_name : string;
+ mutable items : linear_item_info list;
+ mutable for_pack : string option
+ }
+
+type error =
+ | Wrong_format of string
+ | Wrong_version of string
+ | Corrupted of string
+ | Marshal_failed of string
+
+exception Error of error
+
+let save filename linear_unit_info =
+ let ch = open_out_bin filename in
+ Misc.try_finally (fun () ->
+ output_string ch Config.linear_magic_number;
+ output_value ch linear_unit_info;
+ (* Saved because Linearize and Emit depend on Cmm.label. *)
+ output_value ch (Cmm.cur_label ());
+ (* Compute digest of the contents and append it to the file. *)
+ flush ch;
+ let crc = Digest.file filename in
+ output_value ch crc
+ )
+ ~always:(fun () -> close_out ch)
+ ~exceptionally:(fun () -> raise (Error (Marshal_failed filename)))
+
+let restore filename =
+ let ic = open_in_bin filename in
+ Misc.try_finally
+ (fun () ->
+ let magic = Config.linear_magic_number in
+ let buffer = really_input_string ic (String.length magic) in
+ if String.equal buffer magic then begin
+ try
+ let linear_unit_info = (input_value ic : linear_unit_info) in
+ let last_label = (input_value ic : Cmm.label) in
+ Cmm.reset ();
+ Cmm.set_label last_label;
+ let crc = (input_value ic : Digest.t) in
+ linear_unit_info, crc
+ with End_of_file | Failure _ -> raise (Error (Corrupted filename))
+ | Error e -> raise (Error e)
+ end
+ else if String.sub buffer 0 9 = String.sub magic 0 9 then
+ raise (Error (Wrong_version filename))
+ else
+ raise (Error (Wrong_format filename))
+ )
+ ~always:(fun () -> close_in ic)
+
+(* Error report *)
+
+open Format
+
+let report_error ppf = function
+ | Wrong_format filename ->
+ fprintf ppf "Expected Linear format. Incompatible file %a"
+ Location.print_filename filename
+ | Wrong_version filename ->
+ fprintf ppf
+ "%a@ is not compatible with this version of OCaml"
+ Location.print_filename filename
+ | Corrupted filename ->
+ fprintf ppf "Corrupted format@ %a"
+ Location.print_filename filename
+ | Marshal_failed filename ->
+ fprintf ppf "Failed to marshal Linear to file@ %a"
+ Location.print_filename filename
+
+let () =
+ Location.register_error_of_exn
+ (function
+ | Error err -> Some (Location.error_of_printer_file report_error err)
+ | _ -> None
+ )
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* Greta Yorsh, Jane Street Europe *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* Copyright 2019 Jane Street Group LLC *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(* Format of .cmir-linear files *)
+
+(* Compiler can optionally save Linear representation of a compilation unit,
+ along with other information required to emit assembly. *)
+type linear_item_info =
+ | Func of Linear.fundecl
+ | Data of Cmm.data_item list
+
+type linear_unit_info =
+ {
+ mutable unit_name : string;
+ mutable items : linear_item_info list;
+ mutable for_pack : string option
+ }
+
+(* Marshal and unmarshal a compilation unit in Linear format.
+ It includes saving and restoring global state required for Emit,
+ that currently consists of Cmm.label_counter.
+*)
+val save : string -> linear_unit_info -> unit
+val restore : string -> linear_unit_info * Digest.t
module Scoped_location = struct
type scope_item =
| Sc_anonymous_function
- | Sc_value_definition of string
- | Sc_module_definition of string
- | Sc_class_definition of string
- | Sc_method_definition of string
+ | Sc_value_definition
+ | Sc_module_definition
+ | Sc_class_definition
+ | Sc_method_definition
- type scopes = scope_item list
+ type scopes =
+ | Empty
+ | Cons of {item: scope_item; str: string; str_fun: string}
+
+ let str_fun = function
+ | Empty -> "(fun)"
+ | Cons r -> r.str_fun
+
+ let cons item str =
+ Cons {item; str; str_fun = str ^ ".(fun)"}
+
+ let empty_scopes = Empty
let add_parens_if_symbolic = function
| "" -> ""
| 'a'..'z' | 'A'..'Z' | '_' | '0'..'9' -> s
| _ -> "(" ^ s ^ ")"
- let string_of_scope_item = function
- | Sc_anonymous_function ->
- "(fun)"
- | Sc_value_definition name
- | Sc_module_definition name
- | Sc_class_definition name
- | Sc_method_definition name ->
- add_parens_if_symbolic name
-
- let string_of_scopes scopes =
- let dot acc =
- match acc with
- | [] -> []
- | acc -> "." :: acc in
- let rec to_strings acc = function
- | [] -> acc
- (* Collapse nested anonymous function scopes *)
- | Sc_anonymous_function :: ((Sc_anonymous_function :: _) as rest) ->
- to_strings acc rest
- (* Use class#meth syntax for classes *)
- | (Sc_method_definition _ as meth) ::
- (Sc_class_definition _ as cls) :: rest ->
- to_strings (string_of_scope_item cls :: "#" ::
- string_of_scope_item meth :: dot acc) rest
- | s :: rest ->
- to_strings (string_of_scope_item s :: dot acc) rest in
+ let dot ?(sep = ".") scopes s =
+ let s = add_parens_if_symbolic s in
match scopes with
- | [] -> "<unknown>"
- | scopes -> String.concat "" (to_strings [] scopes)
+ | Empty -> s
+ | Cons {str; _} -> str ^ sep ^ s
let enter_anonymous_function ~scopes =
- Sc_anonymous_function :: scopes
+ let str = str_fun scopes in
+ Cons {item = Sc_anonymous_function; str; str_fun = str}
+
let enter_value_definition ~scopes id =
- Sc_value_definition (Ident.name id) :: scopes
+ cons Sc_value_definition (dot scopes (Ident.name id))
+
let enter_module_definition ~scopes id =
- Sc_module_definition (Ident.name id) :: scopes
+ cons Sc_module_definition (dot scopes (Ident.name id))
+
let enter_class_definition ~scopes id =
- Sc_class_definition (Ident.name id) :: scopes
- let enter_method_definition ~scopes (m : Asttypes.label) =
- Sc_method_definition m :: scopes
+ cons Sc_class_definition (dot scopes (Ident.name id))
+
+ let enter_method_definition ~scopes (s : Asttypes.label) =
+ let str =
+ match scopes with
+ | Cons {item = Sc_class_definition; _} -> dot ~sep:"#" scopes s
+ | _ -> dot scopes s
+ in
+ cons Sc_method_definition str
+
+ let string_of_scopes = function
+ | Empty -> "<unknown>"
+ | Cons {str; _} -> str
type t =
| Loc_unknown
(**************************************************************************)
module Scoped_location : sig
- type scope_item =
- | Sc_anonymous_function
- | Sc_value_definition of string
- | Sc_module_definition of string
- | Sc_class_definition of string
- | Sc_method_definition of string
-
- type scopes = scope_item list
- val string_of_scope_item : scope_item -> string
+ type scopes
val string_of_scopes : scopes -> string
+ val empty_scopes : scopes
val enter_anonymous_function : scopes:scopes -> scopes
val enter_value_definition : scopes:scopes -> Ident.t -> scopes
val enter_module_definition : scopes:scopes -> Ident.t -> scopes
type structured_constant =
Const_base of constant
- | Const_pointer of int
| Const_block of int * structured_constant list
| Const_float_array of string list
| Const_immstring of string
+type tailcall_attribute =
+ | Tailcall_expectation of bool
+ (* [@tailcall] and [@tailcall true] have [true],
+ [@tailcall false] has [false] *)
+ | Default_tailcall (* no [@tailcall] attribute *)
+
type inline_attribute =
| Always_inline (* [@inline] or [@inline always] *)
| Never_inline (* [@inline never] *)
{ ap_func : lambda;
ap_args : lambda list;
ap_loc : scoped_location;
- ap_should_be_tailcall : bool;
+ ap_tailcall : tailcall_attribute;
ap_inlined : inline_attribute;
ap_specialised : specialise_attribute; }
required_globals : Ident.Set.t;
code : lambda }
-let const_unit = Const_pointer 0
+let const_int n = Const_base (Const_int n)
+
+let const_unit = const_int 0
let lambda_unit = Lconst const_unit
Assumes that the image of the substitution is out of reach
of the bound variables of the lambda-term (no capture). *)
-let subst update_env s lam =
- let rec subst s lam =
- let remove_list l s =
- List.fold_left (fun s (id, _kind) -> Ident.Map.remove id s) s l
- in
+let subst update_env ?(freshen_bound_variables = false) s input_lam =
+ (* [s] contains a partial substitution for the free variables of the
+ input term [input_lam].
+
+ During our traversal of the term we maintain a second environment
+ [l] with all the bound variables of [input_lam] in the current
+ scope, mapped to either themselves or freshened versions of
+ themselves when [freshen_bound_variables] is set. *)
+ let bind id l =
+ let id' = if not freshen_bound_variables then id else Ident.rename id in
+ id', Ident.Map.add id id' l
+ in
+ let bind_many ids l =
+ List.fold_right (fun (id, rhs) (ids', l) ->
+ let id', l = bind id l in
+ ((id', rhs) :: ids' , l)
+ ) ids ([], l)
+ in
+ let rec subst s l lam =
match lam with
- | Lvar id as l ->
- begin try Ident.Map.find id s with Not_found -> l end
+ | Lvar id as lam ->
+ begin match Ident.Map.find id l with
+ | id' -> Lvar id'
+ | exception Not_found ->
+ (* note: as this point we know [id] is not a bound
+ variable of the input term, otherwise it would belong
+ to [l]; it is a free variable of the input term. *)
+ begin try Ident.Map.find id s with Not_found -> lam end
+ end
| Lconst _ as l -> l
| Lapply ap ->
- Lapply{ap with ap_func = subst s ap.ap_func;
- ap_args = subst_list s ap.ap_args}
+ Lapply{ap with ap_func = subst s l ap.ap_func;
+ ap_args = subst_list s l ap.ap_args}
| Lfunction lf ->
- let s =
- List.fold_right
- (fun (id, _) s -> Ident.Map.remove id s)
- lf.params s
- in
- Lfunction {lf with body = subst s lf.body}
+ let params, l' = bind_many lf.params l in
+ Lfunction {lf with params; body = subst s l' lf.body}
| Llet(str, k, id, arg, body) ->
- Llet(str, k, id, subst s arg, subst (Ident.Map.remove id s) body)
+ let id, l' = bind id l in
+ Llet(str, k, id, subst s l arg, subst s l' body)
| Lletrec(decl, body) ->
- let s =
- List.fold_left (fun s (id, _) -> Ident.Map.remove id s)
- s decl
- in
- Lletrec(List.map (subst_decl s) decl, subst s body)
- | Lprim(p, args, loc) -> Lprim(p, subst_list s args, loc)
+ let decl, l' = bind_many decl l in
+ Lletrec(List.map (subst_decl s l') decl, subst s l' body)
+ | Lprim(p, args, loc) -> Lprim(p, subst_list s l args, loc)
| Lswitch(arg, sw, loc) ->
- Lswitch(subst s arg,
- {sw with sw_consts = List.map (subst_case s) sw.sw_consts;
- sw_blocks = List.map (subst_case s) sw.sw_blocks;
- sw_failaction = subst_opt s sw.sw_failaction; },
+ Lswitch(subst s l arg,
+ {sw with sw_consts = List.map (subst_case s l) sw.sw_consts;
+ sw_blocks = List.map (subst_case s l) sw.sw_blocks;
+ sw_failaction = subst_opt s l sw.sw_failaction; },
loc)
| Lstringswitch (arg,cases,default,loc) ->
Lstringswitch
- (subst s arg,List.map (subst_strcase s) cases,subst_opt s default,loc)
- | Lstaticraise (i,args) -> Lstaticraise (i, subst_list s args)
+ (subst s l arg,
+ List.map (subst_strcase s l) cases,
+ subst_opt s l default,
+ loc)
+ | Lstaticraise (i,args) -> Lstaticraise (i, subst_list s l args)
| Lstaticcatch(body, (id, params), handler) ->
- Lstaticcatch(subst s body, (id, params),
- subst (remove_list params s) handler)
+ let params, l' = bind_many params l in
+ Lstaticcatch(subst s l body, (id, params),
+ subst s l' handler)
| Ltrywith(body, exn, handler) ->
- Ltrywith(subst s body, exn, subst (Ident.Map.remove exn s) handler)
- | Lifthenelse(e1, e2, e3) -> Lifthenelse(subst s e1, subst s e2, subst s e3)
- | Lsequence(e1, e2) -> Lsequence(subst s e1, subst s e2)
- | Lwhile(e1, e2) -> Lwhile(subst s e1, subst s e2)
+ let exn, l' = bind exn l in
+ Ltrywith(subst s l body, exn, subst s l' handler)
+ | Lifthenelse(e1, e2, e3) ->
+ Lifthenelse(subst s l e1, subst s l e2, subst s l e3)
+ | Lsequence(e1, e2) -> Lsequence(subst s l e1, subst s l e2)
+ | Lwhile(e1, e2) -> Lwhile(subst s l e1, subst s l e2)
| Lfor(v, lo, hi, dir, body) ->
- Lfor(v, subst s lo, subst s hi, dir,
- subst (Ident.Map.remove v s) body)
+ let v, l' = bind v l in
+ Lfor(v, subst s l lo, subst s l hi, dir, subst s l' body)
| Lassign(id, e) ->
- assert(not (Ident.Map.mem id s));
- Lassign(id, subst s e)
+ assert (not (Ident.Map.mem id s));
+ let id = try Ident.Map.find id l with Not_found -> id in
+ Lassign(id, subst s l e)
| Lsend (k, met, obj, args, loc) ->
- Lsend (k, subst s met, subst s obj, subst_list s args, loc)
+ Lsend (k, subst s l met, subst s l obj, subst_list s l args, loc)
| Levent (lam, evt) ->
- let lev_env =
- Ident.Map.fold (fun id _ env ->
- match Env.find_value (Path.Pident id) evt.lev_env with
- | exception Not_found -> env
- | vd -> update_env id vd env
- ) s evt.lev_env
+ let old_env = evt.lev_env in
+ let env_updates =
+ let find_in_old id = Env.find_value (Path.Pident id) old_env in
+ let rebind id id' new_env =
+ match find_in_old id with
+ | exception Not_found -> new_env
+ | vd -> Env.add_value id' vd new_env
+ in
+ let update_free id new_env =
+ match find_in_old id with
+ | exception Not_found -> new_env
+ | vd -> update_env id vd new_env
+ in
+ Ident.Map.merge (fun id bound free ->
+ match bound, free with
+ | Some id', _ ->
+ if Ident.equal id id' then None else Some (rebind id id')
+ | None, Some _ -> Some (update_free id)
+ | None, None -> None
+ ) l s
+ in
+ let new_env =
+ Ident.Map.fold (fun _id update env -> update env) env_updates old_env
in
- Levent (subst s lam, { evt with lev_env })
- | Lifused (v, e) -> Lifused (v, subst s e)
- and subst_list s l = List.map (subst s) l
- and subst_decl s (id, exp) = (id, subst s exp)
- and subst_case s (key, case) = (key, subst s case)
- and subst_strcase s (key, case) = (key, subst s case)
- and subst_opt s = function
+ Levent (subst s l lam, { evt with lev_env = new_env })
+ | Lifused (id, e) ->
+ let id = try Ident.Map.find id l with Not_found -> id in
+ Lifused (id, subst s l e)
+ and subst_list s l li = List.map (subst s l) li
+ and subst_decl s l (id, exp) = (id, subst s l exp)
+ and subst_case s l (key, case) = (key, subst s l case)
+ and subst_strcase s l (key, case) = (key, subst s l case)
+ and subst_opt s l = function
| None -> None
- | Some e -> Some (subst s e)
+ | Some e -> Some (subst s l e)
in
- subst s lam
+ subst s Ident.Map.empty input_lam
let rename idmap lam =
let update_env oldid vd env =
let s = Ident.Map.map (fun new_id -> Lvar new_id) idmap in
subst update_env s lam
+let duplicate lam =
+ subst
+ (fun _ _ env -> env)
+ ~freshen_bound_variables:true
+ Ident.Map.empty
+ lam
+
let shallow_map f = function
| Lvar _
| Lconst _ as lam -> lam
- | Lapply { ap_func; ap_args; ap_loc; ap_should_be_tailcall;
+ | Lapply { ap_func; ap_args; ap_loc; ap_tailcall;
ap_inlined; ap_specialised } ->
Lapply {
ap_func = f ap_func;
ap_args = List.map f ap_args;
ap_loc;
- ap_should_be_tailcall;
+ ap_tailcall;
ap_inlined;
ap_specialised;
}
| 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 reset () =
raise_count := 0
type structured_constant =
Const_base of constant
- | Const_pointer of int
| Const_block of int * structured_constant list
| Const_float_array of string list
| Const_immstring of string
+type tailcall_attribute =
+ | Tailcall_expectation of bool
+ (* [@tailcall] and [@tailcall true] have [true],
+ [@tailcall false] has [false] *)
+ | Default_tailcall (* no [@tailcall] attribute *)
+
type inline_attribute =
| Always_inline (* [@inline] or [@inline always] *)
| Never_inline (* [@inline never] *)
{ ap_func : lambda;
ap_args : lambda list;
ap_loc : scoped_location;
- ap_should_be_tailcall : bool; (* true if [@tailcall] was specified *)
+ ap_tailcall : tailcall_attribute;
ap_inlined : inline_attribute; (* specified with the [@inlined] attribute *)
ap_specialised : specialise_attribute; }
val make_key: lambda -> lambda option
val const_unit: structured_constant
+val const_int : int -> structured_constant
val lambda_unit: lambda
val name_lambda: let_kind -> lambda -> (Ident.t -> lambda) -> lambda
val name_lambda_list: lambda list -> (lambda list -> lambda) -> lambda
val make_sequence: ('a -> lambda) -> 'a list -> lambda
-val subst: (Ident.t -> Types.value_description -> Env.t -> Env.t) ->
+val subst:
+ (Ident.t -> Types.value_description -> Env.t -> Env.t) ->
+ ?freshen_bound_variables:bool ->
lambda Ident.Map.t -> lambda -> lambda
-(** [subst env_update_fun s lt] applies a substitution [s] to the lambda-term
- [lt].
+(** [subst update_env ?freshen_bound_variables s lt]
+ applies a substitution [s] to the lambda-term [lt].
Assumes that the image of the substitution is out of reach
of the bound variables of the lambda-term (no capture).
- [env_update_fun] is used to refresh the environment contained in debug
- events. *)
+ [update_env] is used to refresh the environment contained in debug
+ events.
+
+ [freshen_bound_variables], which defaults to [false], freshens
+ the bound variables within [lt].
+ *)
val rename : Ident.t Ident.Map.t -> lambda -> lambda
(** A version of [subst] specialized for the case where we're just renaming
idents. *)
+val duplicate : lambda -> lambda
+(** Duplicate a term, freshening all locally-bound identifiers. *)
+
val map : (lambda -> lambda) -> lambda -> lambda
(** Bottom-up rewriting, applying the function on
each node from the leaves to the root. *)
val function_is_curried : lfunction -> bool
+val max_arity : unit -> int
+ (** Maximal number of parameters for a function, or in other words,
+ maximal length of the [params] list of a [lfunction] record.
+ This is unlimited ([max_int]) for bytecode, but limited
+ (currently to 126) for native code. *)
+
(***********************)
(* For static failures *)
(***********************)
open Parmatch
open Printf
open Printpat
-open Debuginfo.Scoped_location
+
+module Scoped_location = Debuginfo.Scoped_location
let dbg = false
let all_record_args lbls =
match lbls with
+ | [] -> fatal_error "Matching.all_record_args"
| (_, { lbl_all }, _) :: _ ->
let t =
Array.map
- (fun lbl -> (mknoloc (Longident.Lident "?temp?"), lbl, omega))
+ (fun lbl ->
+ (mknoloc (Longident.Lident "?temp?"), lbl, Patterns.omega))
lbl_all
in
List.iter (fun ((_, lbl, _) as x) -> t.(lbl.lbl_pos) <- x) lbls;
Array.to_list t
- | _ -> fatal_error "Matching.all_record_args"
-
-type 'a clause = 'a * lambda
-
-module Non_empty_clause = struct
- type 'a t = ('a * Typedtree.pattern list) clause
-
- let of_initial = function
- | [], _ -> assert false
- | pat :: patl, act -> ((pat, patl), act)
- let map_head f ((p, patl), act) = ((f p, patl), act)
-end
+let expand_record_head h =
+ let open Patterns.Head in
+ match h.pat_desc with
+ | Record [] -> fatal_error "Matching.expand_record_head"
+ | Record ({ lbl_all } :: _) ->
+ { h with pat_desc = Record (Array.to_list lbl_all) }
+ | _ -> h
-type simple_view =
- [ `Any
- | `Constant of constant
- | `Tuple of pattern list
- | `Construct of Longident.t loc * constructor_description * pattern list
- | `Variant of label * pattern option * row_desc ref
- | `Record of
- (Longident.t loc * label_description * pattern) list * closed_flag
- | `Array of pattern list
- | `Lazy of pattern ]
+let head_loc ~scopes head =
+ Scoped_location.of_location ~scopes head.pat_loc
-type half_simple_view =
- [ simple_view | `Or of pattern * pattern * row_desc option ]
+type 'a clause = 'a * lambda
-type general_view =
- [ half_simple_view
- | `Var of Ident.t * string loc
- | `Alias of pattern * Ident.t * string loc ]
+let map_on_row f (row, action) = (f row, action)
-module General : sig
- type pattern = general_view pattern_data
+let map_on_rows f = List.map (map_on_row f)
- type clause = pattern Non_empty_clause.t
+module Non_empty_row = Patterns.Non_empty_row
- val view : Typedtree.pattern -> pattern
+module General = struct
+ include Patterns.General
- val erase : [< general_view ] pattern_data -> Typedtree.pattern
-end = struct
- type pattern = general_view pattern_data
-
- type clause = pattern Non_empty_clause.t
-
- let view_desc = function
- | Tpat_any -> `Any
- | Tpat_var (id, str) -> `Var (id, str)
- | Tpat_alias (p, id, str) -> `Alias (p, id, str)
- | Tpat_constant cst -> `Constant cst
- | Tpat_tuple ps -> `Tuple ps
- | Tpat_construct (cstr, cstr_descr, args) ->
- `Construct (cstr, cstr_descr, args)
- | Tpat_variant (cstr, arg, row_desc) -> `Variant (cstr, arg, row_desc)
- | Tpat_record (fields, closed) -> `Record (fields, closed)
- | Tpat_array ps -> `Array ps
- | Tpat_or (p, q, row_desc) -> `Or (p, q, row_desc)
- | Tpat_lazy p -> `Lazy p
-
- let view p : pattern = { p with pat_desc = view_desc p.pat_desc }
-
- let erase_desc = function
- | `Any -> Tpat_any
- | `Var (id, str) -> Tpat_var (id, str)
- | `Alias (p, id, str) -> Tpat_alias (p, id, str)
- | `Constant cst -> Tpat_constant cst
- | `Tuple ps -> Tpat_tuple ps
- | `Construct (cstr, cst_descr, args) ->
- Tpat_construct (cstr, cst_descr, args)
- | `Variant (cstr, arg, row_desc) -> Tpat_variant (cstr, arg, row_desc)
- | `Record (fields, closed) -> Tpat_record (fields, closed)
- | `Array ps -> Tpat_array ps
- | `Or (p, q, row_desc) -> Tpat_or (p, q, row_desc)
- | `Lazy p -> Tpat_lazy p
-
- let erase p = { p with pat_desc = erase_desc p.pat_desc }
+ type nonrec clause = pattern Non_empty_row.t clause
end
module Half_simple : sig
+ include module type of Patterns.Half_simple
(** Half-simplified patterns are patterns where:
- records are expanded so that they possess all fields
- aliases are removed and replaced by bindings in actions.
In particular, or-patterns may still occur in the leading column,
so this is only a "half-simplification". *)
- type pattern = half_simple_view pattern_data
-
- type clause = pattern Non_empty_clause.t
+ type nonrec clause = pattern Non_empty_row.t clause
val of_clause : arg:lambda -> General.clause -> clause
end = struct
- type pattern = half_simple_view pattern_data
+ include Patterns.Half_simple
- type clause = pattern Non_empty_clause.t
+ type nonrec clause = pattern Non_empty_row.t clause
let rec simpl_under_orpat p =
match p.pat_desc with
(* Explode or-patterns and turn aliases into bindings in actions *)
let of_clause ~arg cl =
let rec aux (((p, patl), action) : General.clause) : clause =
- let continue p (view : general_view) : clause =
+ let continue p (view : General.view) : clause =
aux (({ p with pat_desc = view }, patl), action)
in
- let stop p (view : half_simple_view) : clause =
+ let stop p (view : view) : clause =
(({ p with pat_desc = view }, patl), action)
in
match p.pat_desc with
| `Any -> stop p `Any
- | `Var (id, s) -> continue p (`Alias (omega, id, s))
+ | `Var (id, s) -> continue p (`Alias (Patterns.omega, id, s))
| `Alias (p, id, _) ->
let k = Typeopt.value_kind p.pat_env p.pat_type in
aux
exception Cannot_flatten
module Simple : sig
- type pattern = simple_view pattern_data
+ include module type of Patterns.Simple
- type clause = pattern Non_empty_clause.t
+ type nonrec clause = pattern Non_empty_row.t clause
- val head : pattern -> Pattern_head.t
+ val head : pattern -> Patterns.Head.t
val explode_or_pat :
Half_simple.pattern * Typedtree.pattern list ->
- arg:Ident.t option ->
+ arg_id:Ident.t option ->
mk_action:(vars:Ident.t list -> lambda) ->
vars:Ident.t list ->
clause list ->
clause list
+ (** If the toplevel pattern is given a name, but the scrutinee is not named
+ (i.e. [arg_id = None]), which happens (only) when matching a literal
+ tuple, then [Cannot_flatten] is raised. *)
end = struct
- type pattern = simple_view pattern_data
+ include Patterns.Simple
- type clause = pattern Non_empty_clause.t
+ type nonrec clause = pattern Non_empty_row.t clause
- let head p =
- fst (Pattern_head.deconstruct (General.erase (p :> General.pattern)))
+ let head p = fst (Patterns.Head.deconstruct p)
let alpha env (p : pattern) : pattern =
let alpha_pat env p = Typedtree.alpha_pat env p in
in
{ p with pat_desc }
- let mk_alpha_env arg aliases ids =
+ let mk_alpha_env arg_id aliases ids =
List.map
(fun id ->
( id,
if List.mem id aliases then
- match arg with
+ match arg_id with
| Some v -> v
| _ -> raise Cannot_flatten
else
Ident.create_local (Ident.name id) ))
ids
- let explode_or_pat ((p : Half_simple.pattern), patl) ~arg ~mk_action ~vars
+ let explode_or_pat ((p : Half_simple.pattern), patl) ~arg_id ~mk_action ~vars
(rem : clause list) : clause list =
let rec explode p aliases rem =
let split_explode p aliases rem = explode (General.view p) aliases rem in
| `Alias (p, id, _) -> split_explode p (id :: aliases) rem
| `Var (id, str) ->
explode
- { p with pat_desc = `Alias (Parmatch.omega, id, str) }
+ { p with pat_desc = `Alias (Patterns.omega, id, str) }
aliases rem
- | #simple_view as view ->
- let env = mk_alpha_env arg aliases vars in
+ | #view as view ->
+ let env = mk_alpha_env arg_id aliases vars in
( (alpha env { p with pat_desc = view }, patl),
mk_action ~vars:(List.map snd env) )
:: rem
explode (p : Half_simple.pattern :> General.pattern) [] rem
end
+let expand_record_simple : Simple.pattern -> Simple.pattern =
+ fun p ->
+ match p.pat_desc with
+ | `Record (l, _) -> { p with pat_desc = `Record (all_record_args l, Closed) }
+ | _ -> p
+
type initial_clause = pattern list clause
type matrix = pattern list list
-let add_omega_column pss = List.map (fun ps -> omega :: ps) pss
+let add_omega_column pss = List.map (fun ps -> Patterns.omega :: ps) pss
let rec rev_split_at n ps =
if n <= 0 then
exception NoMatch
+let matcher discr (p : Simple.pattern) rem =
+ let discr = expand_record_head discr in
+ let p = expand_record_simple p in
+ let omegas = Patterns.(omegas (Head.arity discr)) in
+ let ph, args = Patterns.Head.deconstruct p in
+ let yes () = args @ rem in
+ let no () = raise NoMatch in
+ let yesif b =
+ if b then
+ yes ()
+ else
+ no ()
+ in
+ let open Patterns.Head in
+ match (discr.pat_desc, ph.pat_desc) with
+ | Any, _ -> rem
+ | ( ( Constant _ | Construct _ | Variant _ | Lazy | Array _ | Record _
+ | Tuple _ ),
+ Any ) ->
+ omegas @ rem
+ | Constant cst, Constant cst' -> yesif (const_compare cst cst' = 0)
+ | Constant _, (Construct _ | Variant _ | Lazy | Array _ | Record _ | Tuple _)
+ ->
+ no ()
+ | Construct cstr, Construct cstr' ->
+ (* NB: may_equal_constr considers (potential) constructor rebinding;
+ Types.may_equal_constr does check that the arities are the same,
+ preserving row-size coherence. *)
+ yesif (Types.may_equal_constr cstr cstr')
+ | Construct _, (Constant _ | Variant _ | Lazy | Array _ | Record _ | Tuple _)
+ ->
+ no ()
+ | Variant { tag; has_arg }, Variant { tag = tag'; has_arg = has_arg' } ->
+ yesif (tag = tag' && has_arg = has_arg')
+ | Variant _, (Constant _ | Construct _ | Lazy | Array _ | Record _ | Tuple _)
+ ->
+ no ()
+ | Array n1, Array n2 -> yesif (n1 = n2)
+ | Array _, (Constant _ | Construct _ | Variant _ | Lazy | Record _ | Tuple _)
+ ->
+ no ()
+ | Tuple n1, Tuple n2 -> yesif (n1 = n2)
+ | Tuple _, (Constant _ | Construct _ | Variant _ | Lazy | Array _ | Record _)
+ ->
+ no ()
+ | Record l, Record l' ->
+ (* we already expanded the record fully *)
+ yesif (List.length l = List.length l')
+ | Record _, (Constant _ | Construct _ | Variant _ | Lazy | Array _ | Tuple _)
+ ->
+ no ()
+ | Lazy, Lazy -> yes ()
+ | Lazy, (Constant _ | Construct _ | Variant _ | Array _ | Record _ | Tuple _)
+ ->
+ no ()
+
let ncols = function
| [] -> 0
| ps :: _ -> List.length ps
val eprintf : t -> unit
- val specialize : pattern -> t -> t
+ val specialize : Patterns.Head.t -> t -> t
val lshift : t -> t
let lforget { left; right } =
match right with
- | _ :: xs -> { left = omega :: left; right = xs }
+ | _ :: xs -> { left = Patterns.omega :: left; right = xs }
| _ -> assert false
let rshift { left; right } =
let empty = []
- let start n : t = [ { left = []; right = omegas n } ]
+ let start n : t = [ { left = []; right = Patterns.omegas n } ]
let is_empty = function
| [] -> true
let combine ctx = List.map Row.combine ctx
- let ctx_matcher p q rem =
- let rec expand_record p =
- match p.pat_desc with
- | Tpat_record (l, _) ->
- { p with pat_desc = Tpat_record (all_record_args l, Closed) }
- | Tpat_alias (p, _, _) -> expand_record p
- | _ -> p
- in
- let ph, omegas =
- let ph, p_args = Pattern_head.deconstruct (expand_record p) in
- (ph, List.map (fun _ -> omega) p_args)
- in
- let qh, args = Pattern_head.deconstruct (expand_record q) in
- let yes () = (p, args @ rem) in
- let no () = raise NoMatch in
- let yesif b =
- if b then
- yes ()
- else
- no ()
+ let specialize head ctx =
+ let non_empty = function
+ | { Row.left = _; right = [] } ->
+ fatal_error "Matching.Context.specialize"
+ | { Row.left; right = p :: ps } -> (left, p, ps)
in
- match (Pattern_head.desc ph, Pattern_head.desc qh) with
- | Any, _ -> fatal_error "Matching.Context.matcher"
- | _, Any -> (p, omegas @ rem)
- | Construct cstr, Construct cstr' ->
- (* NB: may_equal_constr considers (potential) constructor rebinding *)
- yesif (Types.may_equal_constr cstr cstr')
- | Construct _, _ -> no ()
- | Constant cst, Constant cst' -> yesif (const_compare cst cst' = 0)
- | Constant _, _ -> no ()
- | Variant { tag; has_arg }, Variant { tag = tag'; has_arg = has_arg' } ->
- yesif (tag = tag' && has_arg = has_arg')
- | Variant _, _ -> no ()
- | Array n1, Array n2 -> yesif (n1 = n2)
- | Array _, _ -> no ()
- | Tuple n1, Tuple n2 -> yesif (n1 = n2)
- | Tuple _, _ -> no ()
- | Record l, Record l' ->
- (* we called expand_record on both arguments so l, l' are full *)
- yesif (List.length l = List.length l')
- | Record _, _ -> no ()
- | Lazy, Lazy -> yes ()
- | Lazy, _ -> no ()
-
- let specialize q ctx =
- let matcher = ctx_matcher q in
- let rec filter_rec : t -> t = function
- | ({ right = p :: ps } as l) :: rem -> (
+ let ctx = List.map non_empty ctx in
+ let rec filter_rec = function
+ | [] -> []
+ | (left, p, right) :: rem -> (
+ let p = General.view p in
match p.pat_desc with
- | Tpat_or (p1, p2, _) ->
- filter_rec
- ({ l with right = p1 :: ps }
- :: { l with
- Row.right (* disam not principal, OK *) = p2 :: ps
- }
- :: rem
- )
- | Tpat_alias (p, _, _) ->
- filter_rec ({ l with right = p :: ps } :: rem)
- | Tpat_var _ -> filter_rec ({ l with right = omega :: ps } :: rem)
- | _ -> (
- let rem = filter_rec rem in
- try
- let to_left, right = matcher p ps in
- { left = to_left :: l.left; right } :: rem
- with NoMatch -> rem
+ | `Or (p1, p2, _) ->
+ filter_rec ((left, p1, right) :: (left, p2, right) :: rem)
+ | `Alias (p, _, _) -> filter_rec ((left, p, right) :: rem)
+ | `Var _ -> filter_rec ((left, Patterns.omega, right) :: rem)
+ | #Simple.view as view -> (
+ let p = { p with pat_desc = view } in
+ match matcher head p right with
+ | exception NoMatch -> filter_rec rem
+ | right ->
+ let left = Patterns.Head.to_omega_pattern head :: left in
+ { Row.left; right }
+ :: filter_rec rem
)
)
- | [] -> []
- | _ -> fatal_error "Matching.Context.specialize"
in
filter_rec ctx
let union pss qss = get_mins Row.le (pss @ qss)
end
-exception OrPat
-
let rec flatten_pat_line size p k =
match p.pat_desc with
- | Tpat_any -> omegas size :: k
+ | Tpat_any -> Patterns.omegas size :: k
| Tpat_tuple args -> args :: k
| Tpat_or (p1, p2, _) ->
flatten_pat_line size p1 (flatten_pat_line size p2 k)
val cons : matrix -> int -> t -> t
- val specialize : (pattern -> pattern list -> pattern list) -> t -> t
+ val specialize : Patterns.Head.t -> t -> t
val pop_column : t -> t
| [] -> default
| _ -> (matrix, raise_num) :: default
- let specialize_matrix matcher pss =
+ let specialize_matrix arity matcher pss =
let rec filter_rec = function
- | (p :: ps) :: rem -> (
+ | [] -> []
+ | (p, ps) :: rem -> (
+ let p = General.view p in
match p.pat_desc with
- | Tpat_alias (p, _, _) -> filter_rec ((p :: ps) :: rem)
- | Tpat_var _ -> filter_rec ((omega :: ps) :: rem)
- | _ -> (
- let rem = filter_rec rem in
- try matcher p ps :: rem with
- | NoMatch -> rem
- | OrPat -> (
- match p.pat_desc with
- | Tpat_or (p1, p2, _) ->
- filter_rec [ p1 :: ps; p2 :: ps ] @ rem
- | _ -> assert false
- )
+ | `Alias (p, _, _) -> filter_rec ((p, ps) :: rem)
+ | `Var _ -> filter_rec ((Patterns.omega, ps) :: rem)
+ | `Or (p1, p2, _) -> filter_rec_or p1 p2 ps rem
+ | #Simple.view as view -> (
+ let p = { p with pat_desc = view } in
+ match matcher p ps with
+ | exception NoMatch -> filter_rec rem
+ | specialized ->
+ assert (List.length specialized = List.length ps + arity);
+ specialized :: filter_rec rem
)
)
- | [] -> []
+
+ (* Filter just one row, without a `rem` accumulator
+ of further rows to process.
+ The following equality holds:
+ filter_rec ((p :: ps) :: rem)
+ = filter_one p ps @ filter_rec rem
+ *)
+ and filter_one p ps =
+ filter_rec [ (p, ps) ]
+
+ and filter_rec_or p1 p2 ps rem =
+ match arity with
+ | 0 -> (
+ (* if K has arity 0, specializing ((K|K)::rem) returns just (rem):
+ if either sides works (filters into a non-empty list),
+ no need to keep the other. *)
+ match filter_one p1 ps with
+ | [] -> filter_rec ((p2, ps) :: rem)
+ | matches -> matches @ filter_rec rem
+ )
+ | 1 -> (
+ (* if K has arity 1, ((K p | K q) :: rem) can be expressed
+ as ((p | q) :: rem): even if both sides of an or-pattern
+ match, we can compress the output in a single row,
+ instead of duplicating the row.
+
+ In particular, filtering a single row (the filter_one calls)
+ returns a result that respects the following properties:
+ - "row count": the result is either an empty list or a single row
+ - "row shape": if there is a row in the result, it contains one
+ pattern consed to the tail [ps] of our input row; in particular
+ the row is not empty. *)
+ match (filter_one p1 ps, filter_one p2 ps) with
+ | [], row
+ | row, [] ->
+ row @ filter_rec rem
+ | [ (arg1 :: _) ], [ (arg2 :: _) ] ->
+ (* By the row shape property,
+ the wildcard patterns can only be ps. *)
+ (* The output below is a single row,
+ respecting the row count property. *)
+ ({ arg1 with
+ pat_desc = Tpat_or (arg1, arg2, None);
+ pat_loc = Location.none
+ }
+ :: ps
+ )
+ :: filter_rec rem
+ | (_ :: _ :: _), _
+ | _, (_ :: _ :: _) ->
+ (* Cannot happen from the row count property. *)
+ assert false
+ | [ [] ], _
+ | _, [ [] ] ->
+ (* Cannot happen from the row shape property. *)
+ assert false
+ )
| _ ->
- pretty_matrix Format.err_formatter pss;
- fatal_error "Matching.Default_environment.specialize_matrix"
+ (* we cannot preserve the or-pattern as in the arity-1 case,
+ because we cannot express
+ (K (p1, .., pn) | K (q1, .. qn))
+ as (p1 .. pn | q1 .. qn) *)
+ filter_rec ((p1, ps) :: (p2, ps) :: rem)
in
filter_rec pss
- let specialize matcher env =
+ let specialize_ arity matcher env =
let rec make_rec = function
| [] -> []
- | ([ [] ], i) :: _ -> [ ([ [] ], i) ]
+ | (([] :: _), i) :: _ -> [ ([ [] ], i) ]
| (pss, i) :: rem -> (
- let rem = make_rec rem in
- match specialize_matrix matcher pss with
- | [] -> rem
+ (* we already handled the empty-row case
+ so we know that all rows in pss are non-empty *)
+ let non_empty = function
+ | [] -> assert false
+ | p :: ps -> (p, ps)
+ in
+ let pss = List.map non_empty pss in
+ match specialize_matrix arity matcher pss with
+ | [] -> make_rec rem
| [] :: _ -> [ ([ [] ], i) ]
- | pss -> (pss, i) :: rem
+ | pss -> (pss, i) :: make_rec rem
)
in
make_rec env
- let pop_column def = specialize (fun _p rem -> rem) def
+ let specialize head def =
+ specialize_ (Patterns.Head.arity head) (matcher head) def
+
+ let pop_column def = specialize_ 0 (fun _p rem -> rem) def
let pop_compat p def =
let compat_matcher q rem =
- if may_compat p q then
+ if may_compat p (General.erase q) then
rem
else
raise NoMatch
in
- specialize compat_matcher def
+ specialize_ 0 compat_matcher def
let pop = function
| [] -> None
}
type 'head_pat pm_or_compiled = {
- body : 'head_pat Non_empty_clause.t pattern_matching;
+ body : 'head_pat Non_empty_row.t clause pattern_matching;
handlers : handler list;
or_matrix : matrix
}
|| not (may_compats (General.erase p :: ps) (General.erase q :: qs)))
l
-let half_simplify_nonempty ~arg (cls : Typedtree.pattern Non_empty_clause.t) :
- Half_simple.clause =
- cls |> Non_empty_clause.map_head General.view |> Half_simple.of_clause ~arg
+let half_simplify_nonempty ~arg (cls : Typedtree.pattern Non_empty_row.t clause)
+ : Half_simple.clause =
+ cls
+ |> map_on_row (Non_empty_row.map_first General.view)
+ |> Half_simple.of_clause ~arg
let half_simplify_clause ~arg (cls : Typedtree.pattern list clause) =
- cls |> Non_empty_clause.of_initial |> half_simplify_nonempty ~arg
+ cls
+ |> map_on_row Non_empty_row.of_initial
+ |> half_simplify_nonempty ~arg
(* Once matchings are *fully* simplified, one can easily find
their nature. *)
let rec what_is_cases ~skip_any cases =
match cases with
- | [] -> Pattern_head.omega
+ | [] -> Patterns.Head.omega
| ((p, _), _) :: rem -> (
let head = Simple.head p in
- match Pattern_head.desc head with
- | Any when skip_any -> what_is_cases ~skip_any rem
+ match head.pat_desc with
+ | Patterns.Head.Any when skip_any -> what_is_cases ~skip_any rem
| _ -> head
)
cases Ident.Set.empty
(* Basic grouping predicates *)
-let pat_as_constr = function
- | { pat_desc = Tpat_construct (_, cstr, _) } -> cstr
- | _ -> fatal_error "Matching.pat_as_constr"
let can_group discr pat =
- match (Pattern_head.desc discr, Pattern_head.desc (Simple.head pat)) with
+ let open Patterns.Head in
+ match (discr.pat_desc, (Simple.head pat).pat_desc) with
| Any, Any
| Constant (Const_int _), Constant (Const_int _)
| Constant (Const_char _), Constant (Const_char _)
| _ -> false
let simple_omega_like p =
- match Pattern_head.desc (Simple.head p) with
+ match (Simple.head p).pat_desc with
| Any -> true
| _ -> false
*)
-let rec split_or argo (cls : Half_simple.clause list) args def =
+let rec split_or ~arg_id (cls : Half_simple.clause list) args def =
let rec do_split (rev_before : Simple.clause list) rev_ors rev_no = function
| [] ->
cons_next (List.rev rev_before) (List.rev rev_ors) (List.rev rev_no)
do_split rev_before rev_ors (cl :: rev_no) rem
| (((p, ps), act) as cl) :: rem -> (
match p.pat_desc with
- | #simple_view as view when safe_before cl rev_ors ->
+ | #Simple.view as view when safe_before cl rev_ors ->
do_split
((({ p with pat_desc = view }, ps), act) :: rev_before)
rev_ors rev_no rem
in
match yesor with
| [] -> split_no_or yes args def nexts
- | _ -> precompile_or argo yes yesor args def nexts
+ | _ -> precompile_or ~arg_id yes yesor args def nexts
in
do_split [] [] [] cls
insert_split group_discr yes no def k
and insert_split group_discr yes no def k =
let precompile_group =
- match Pattern_head.desc group_discr with
- | Any -> precompile_var
+ match group_discr.pat_desc with
+ | Patterns.Head.Any -> precompile_var
| _ -> do_not_precompile
in
match no with
(Default_environment.cons matrix idef def)
((idef, next) :: nexts)
and should_split group_discr =
- match Pattern_head.desc group_discr with
- | Construct { cstr_tag = Cstr_extension _ } ->
+ match group_discr.pat_desc with
+ | Patterns.Head.Construct { cstr_tag = Cstr_extension _ } ->
(* it is unlikely that we will raise anything, so we split now *)
true
| _ -> false
cls
and var_def = Default_environment.pop_column def in
let { me = first; matrix }, nexts =
- split_or (Some v) var_cls var_args var_def
+ split_or ~arg_id:(Some v) var_cls var_args var_def
in
(* Compute top information *)
match nexts with
},
k )
-and precompile_or argo (cls : Simple.clause list) ors args def k =
+and precompile_or ~arg_id (cls : Simple.clause list) ors args def k =
let rec do_cases = function
| [] -> ([], [])
| ((p, patl), action) :: rem -> (
match p.pat_desc with
- | #simple_view as view ->
+ | #Simple.view as view ->
let new_ord, new_to_catch = do_cases rem in
( (({ p with pat_desc = view }, patl), action) :: new_ord,
new_to_catch )
(id, Typeopt.value_kind orp.pat_env ty))
in
let or_num = next_raise_count () in
- let new_patl = Parmatch.omega_list patl in
+ let new_patl = Patterns.omega_list patl in
let mk_new_action ~vars =
Lstaticraise (or_num, List.map (fun v -> Lvar v) vars)
in
let rem_cases, rem_handlers = do_cases rem in
let cases =
- Simple.explode_or_pat (p, new_patl) ~arg:argo
+ Simple.explode_or_pat (p, new_patl) ~arg_id
~mk_action:mk_new_action ~vars:(List.map fst vars) rem_cases
in
let handler =
dbg_split_and_precompile pm next nexts;
(next, nexts)
-let split_and_precompile_half_simplified ~arg pm =
- let { me = next }, nexts = split_or arg pm.cases pm.args pm.default in
+let split_and_precompile_half_simplified ~arg_id pm =
+ let { me = next }, nexts = split_or ~arg_id pm.cases pm.args pm.default in
dbg_split_and_precompile pm next nexts;
(next, nexts)
let pm =
{ pm with cases = List.map (half_simplify_clause ~arg:arg_lambda) pm.cases }
in
- split_and_precompile_half_simplified ~arg:arg_id pm
+ split_and_precompile_half_simplified ~arg_id pm
(* General divide functions *)
type cell = {
pm : initial_clause pattern_matching;
ctx : Context.t;
- discr : pattern
+ discr : Patterns.Head.t
}
(** a submatrix after specializing by discriminant pattern;
[ctx] is the context shared by all rows. *)
+let make_matching get_expr_args head def ctx = function
+ | [] -> fatal_error "Matching.make_matching"
+ | arg :: rem ->
+ let def = Default_environment.specialize head def
+ and args = get_expr_args head arg rem
+ and ctx = Context.specialize head ctx in
+ { pm = { cases = []; args; default = def }; ctx; discr = head }
+
+let make_line_matching get_expr_args head def = function
+ | [] -> fatal_error "Matching.make_line_matching"
+ | arg :: rem ->
+ { cases = [];
+ args = get_expr_args head arg rem;
+ default = Default_environment.specialize head def
+ }
+
type 'a division = {
args : (lambda * let_kind) list;
cells : ('a * cell) list
in
{ division with cells }
-let divide make eq_key get_key get_args ctx
+let divide get_expr_args eq_key get_key get_pat_args ctx
(pm : Simple.clause pattern_matching) =
let add ((p, patl), action) division =
+ let ph = Simple.head p in
let p = General.erase p in
- add_in_div (make p pm.default ctx) eq_key (get_key p)
- (get_args p patl, action)
+ add_in_div
+ (make_matching get_expr_args ph pm.default ctx)
+ eq_key (get_key p)
+ (get_pat_args p patl, action)
division
in
List.fold_right add pm.cases { args = pm.args; cells = [] }
pm.cases <- patl_action :: pm.cases;
pm
-let divide_line make_ctx make get_args discr ctx
+let divide_line make_ctx get_expr_args get_pat_args discr ctx
(pm : Simple.clause pattern_matching) =
let add ((p, patl), action) submatrix =
let p = General.erase p in
- add_line (get_args p patl, action) submatrix
+ add_line (get_pat_args p patl, action) submatrix
+ in
+ let pm =
+ List.fold_right add pm.cases
+ (make_line_matching get_expr_args discr pm.default pm.args)
in
- let pm = List.fold_right add pm.cases (make pm.default pm.args) in
{ pm; ctx = make_ctx ctx; discr }
+let drop_pat_arg _p rem = rem
+let drop_expr_arg _head _arg rem = rem
+
(* Then come various functions,
There is one set of functions per matching style
(constants, constructors etc.)
- - matcher functions are arguments to Default_environment.specialize (for
- default handlers)
- They may raise NoMatch or OrPat and perform the full
- matching (selection + arguments).
-
- - get_args and get_key are for the compiled matrices, note that
- selection and getting arguments are separated.
+ - get_{expr,pat}_args and get_key are for the compiled matrices,
+ note that selection and getting arguments are separated.
- make_*_matching combines the previous functions for producing
new ``pattern_matching'' records.
*)
-let rec matcher_const cst p rem =
- match p.pat_desc with
- | Tpat_or (p1, p2, _) -> (
- try matcher_const cst p1 rem with NoMatch -> matcher_const cst p2 rem
- )
- | Tpat_constant c1 when const_compare c1 cst = 0 -> rem
- | Tpat_any -> rem
- | _ -> raise NoMatch
+(* Matching against a constant *)
let get_key_constant caller = function
| { pat_desc = Tpat_constant cst } -> cst
pretty_pat p;
assert false
-let get_args_constant _ rem = rem
-
-let make_constant_matching p def ctx = function
- | [] -> fatal_error "Matching.make_constant_matching"
- | _ :: argl ->
- let def =
- Default_environment.specialize
- (matcher_const (get_key_constant "make" p))
- def
- and ctx = Context.specialize p ctx in
- { pm = { cases = []; args = argl; default = def };
- ctx;
- discr = normalize_pat p
- }
+let get_pat_args_constant = drop_pat_arg
+let get_expr_args_constant = drop_expr_arg
let divide_constant ctx m =
- divide make_constant_matching
+ divide
+ get_expr_args_constant
(fun c d -> const_compare c d = 0)
(get_key_constant "divide")
- get_args_constant ctx m
+ get_pat_args_constant ctx m
(* Matching against a constructor *)
-let make_field_args loc binding_kind arg first_pos last_pos argl =
- let rec make_args pos =
- if pos > last_pos then
- argl
- else
- (Lprim (Pfield pos, [ arg ], loc), binding_kind) :: make_args (pos + 1)
- in
- make_args first_pos
-
let get_key_constr = function
- | { pat_desc = Tpat_construct (_, cstr, _) } -> cstr.cstr_tag
+ | { pat_desc = Tpat_construct (_, cstr, _) } -> cstr
| _ -> assert false
-let get_args_constr p rem =
+let get_pat_args_constr p rem =
match p with
| { pat_desc = Tpat_construct (_, _, args) } -> args @ rem
| _ -> assert false
-(* NB: matcher_constr applies to default matrices.
-
- In that context, matching by constructors of extensible
- types degrades to arity checking, due to potential rebinding.
- This comparison is performed by Types.may_equal_constr.
-*)
-
-let matcher_constr cstr =
- match cstr.cstr_arity with
- | 0 ->
- let rec matcher_rec q rem =
- match q.pat_desc with
- | Tpat_or (p1, p2, _) -> (
- try matcher_rec p1 rem with NoMatch -> matcher_rec p2 rem
- )
- | Tpat_construct (_, cstr', []) when Types.may_equal_constr cstr cstr'
- ->
- rem
- | Tpat_any -> rem
- | _ -> raise NoMatch
- in
- matcher_rec
- | 1 ->
- let rec matcher_rec q rem =
- match q.pat_desc with
- | Tpat_or (p1, p2, _) -> (
- (* if both sides of the or-pattern match the head constructor,
- (K p1 | K p2) :: rem
- return (p1 | p2) :: rem *)
- let r1 = try Some (matcher_rec p1 rem) with NoMatch -> None
- and r2 = try Some (matcher_rec p2 rem) with NoMatch -> None in
- match (r1, r2) with
- | None, None -> raise NoMatch
- | Some r1, None -> r1
- | None, Some r2 -> r2
- | Some (a1 :: _), Some (a2 :: _) ->
- { a1 with
- pat_loc = Location.none;
- pat_desc = Tpat_or (a1, a2, None)
- }
- :: rem
- | _, _ -> assert false
- )
- | Tpat_construct (_, cstr', [ arg ])
- when Types.may_equal_constr cstr cstr' ->
- arg :: rem
- | Tpat_any -> omega :: rem
- | _ -> raise NoMatch
- in
- matcher_rec
- | _ -> (
- fun q rem ->
- match q.pat_desc with
- | Tpat_or (_, _, _) ->
- (* we cannot preserve the or-pattern as in the arity-1 case,
- because we cannot express
- (K (p1, .., pn) | K (q1, .. qn))
- as (p1 .. pn | q1 .. qn) *)
- raise OrPat
- | Tpat_construct (_, cstr', args)
- when Types.may_equal_constr cstr cstr' ->
- args @ rem
- | Tpat_any -> Parmatch.omegas cstr.cstr_arity @ rem
- | _ -> raise NoMatch
- )
-
-let make_constr_matching ~scopes p def ctx = function
- | [] -> fatal_error "Matching.make_constr_matching"
- | (arg, _mut) :: argl ->
- let cstr = pat_as_constr p in
- let newargs =
- if cstr.cstr_inlined <> None then
- (arg, Alias) :: argl
- else
- match cstr.cstr_tag with
- | Cstr_constant _
- | Cstr_block _ ->
- make_field_args (of_location ~scopes p.pat_loc)
- Alias arg 0 (cstr.cstr_arity - 1) argl
- | Cstr_unboxed -> (arg, Alias) :: argl
- | Cstr_extension _ ->
- make_field_args (of_location ~scopes p.pat_loc)
- Alias arg 1 cstr.cstr_arity argl
- in
- { pm =
- { cases = [];
- args = newargs;
- default = Default_environment.specialize (matcher_constr cstr) def
- };
- ctx = Context.specialize p ctx;
- discr = normalize_pat p
- }
+let get_expr_args_constr ~scopes head (arg, _mut) rem =
+ let cstr =
+ match head.pat_desc with
+ | Patterns.Head.Construct cstr -> cstr
+ | _ -> fatal_error "Matching.get_expr_args_constr"
+ in
+ let loc = head_loc ~scopes head in
+ let make_field_accesses binding_kind first_pos last_pos argl =
+ let rec make_args pos =
+ if pos > last_pos then
+ argl
+ else
+ (Lprim (Pfield pos, [ arg ], loc), binding_kind) :: make_args (pos + 1)
+ in
+ make_args first_pos
+ in
+ if cstr.cstr_inlined <> None then
+ (arg, Alias) :: rem
+ else
+ match cstr.cstr_tag with
+ | Cstr_constant _
+ | Cstr_block _ ->
+ make_field_accesses Alias 0 (cstr.cstr_arity - 1) rem
+ | Cstr_unboxed -> (arg, Alias) :: rem
+ | Cstr_extension _ -> make_field_accesses Alias 1 cstr.cstr_arity rem
let divide_constructor ~scopes ctx pm =
- divide (make_constr_matching ~scopes) ( = )
- get_key_constr get_args_constr ctx pm
+ divide
+ (get_expr_args_constr ~scopes)
+ (fun cstr1 cstr2 -> Types.equal_tag cstr1.cstr_tag cstr2.cstr_tag)
+ get_key_constr
+ get_pat_args_constr
+ ctx pm
(* Matching against a variant *)
-let rec matcher_variant_const lab p rem =
- match p.pat_desc with
- | Tpat_or (p1, p2, _) -> (
- try matcher_variant_const lab p1 rem
- with NoMatch -> matcher_variant_const lab p2 rem
- )
- | Tpat_variant (lab1, _, _) when lab1 = lab -> rem
- | Tpat_any -> rem
- | _ -> raise NoMatch
-
-let make_variant_matching_constant p lab def ctx = function
- | [] -> fatal_error "Matching.make_variant_matching_constant"
- | _ :: argl ->
- let def = Default_environment.specialize (matcher_variant_const lab) def
- and ctx = Context.specialize p ctx in
- { pm = { cases = []; args = argl; default = def };
- ctx;
- discr = normalize_pat p
- }
+let get_expr_args_variant_constant = drop_expr_arg
-let matcher_variant_nonconst lab p rem =
- match p.pat_desc with
- | Tpat_or (_, _, _) -> raise OrPat
- | Tpat_variant (lab1, Some arg, _) when lab1 = lab -> arg :: rem
- | Tpat_any -> omega :: rem
- | _ -> raise NoMatch
-
-let make_variant_matching_nonconst ~scopes p lab def ctx = function
- | [] -> fatal_error "Matching.make_variant_matching_nonconst"
- | (arg, _mut) :: argl ->
- let def =
- Default_environment.specialize (matcher_variant_nonconst lab) def
- and ctx = Context.specialize p ctx
- and loc = of_location ~scopes p.pat_loc in
- { pm =
- { cases = [];
- args = (Lprim (Pfield 1, [ arg ], loc), Alias)
- :: argl;
- default = def
- };
- ctx;
- discr = normalize_pat p
- }
+let get_expr_args_variant_nonconst ~scopes head (arg, _mut) rem =
+ let loc = head_loc ~scopes head in
+ (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
| `Variant (lab, pato, _) -> lab, pato
| _ -> assert false
in
- let p = General.erase p 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
match pato with
| None ->
add_in_div
- (make_variant_matching_constant p lab def ctx)
+ (make_matching get_expr_args_variant_constant head def ctx)
( = ) (Cstr_constant tag) (patl, action) variants
| Some pat ->
add_in_div
- (make_variant_matching_nonconst ~scopes p lab def ctx)
+ (make_matching
+ (get_expr_args_variant_nonconst ~scopes)
+ head def ctx)
( = ) (Cstr_block tag)
(pat :: patl, action)
variants
*)
(* Matching against a variable *)
-let get_args_var _p rem = rem
-let make_var_matching def = function
- | [] -> fatal_error "Matching.make_var_matching"
- | _ :: argl ->
- { cases = [];
- args = argl;
- default = Default_environment.specialize get_args_var def
- }
+let get_pat_args_var = drop_pat_arg
+let get_expr_args_var = drop_expr_arg
let divide_var ctx pm =
- divide_line Context.lshift make_var_matching get_args_var omega ctx pm
+ divide_line Context.lshift
+ get_expr_args_var
+ get_pat_args_var
+ Patterns.Head.omega ctx pm
(* Matching and forcing a lazy value *)
-let get_arg_lazy p rem =
+let get_pat_args_lazy p rem =
match p with
- | { pat_desc = Tpat_any } -> omega :: rem
+ | { pat_desc = Tpat_any } -> Patterns.omega :: rem
| { pat_desc = Tpat_lazy arg } -> arg :: rem
| _ -> assert false
-let matcher_lazy p rem =
- match p.pat_desc with
- | Tpat_or (_, _, _) -> raise OrPat
- | Tpat_any
- | Tpat_var _ ->
- omega :: rem
- | Tpat_lazy arg -> arg :: rem
- | _ -> raise NoMatch
-
(* Inlining the tag tests before calling the primitive that works on
lazy blocks. This is also used in translcore.ml.
No other call than Obj.tag when the value has been forced before.
[ tag_var; Lconst (Const_base (Const_int Obj.lazy_tag)) ],
loc ),
Lapply
- { ap_should_be_tailcall = false;
+ { ap_tailcall = Default_tailcall;
ap_loc = loc;
ap_func = force_fun;
ap_args = [ varg ];
[ (Obj.forward_tag, Lprim (Pfield 0, [ varg ], loc));
( Obj.lazy_tag,
Lapply
- { ap_should_be_tailcall = false;
+ { ap_tailcall = Default_tailcall;
ap_loc = loc;
ap_func = force_fun;
ap_args = [ varg ];
instrumentation output.
(see https://github.com/stedolan/crowbar/issues/14) *)
Lapply
- { ap_should_be_tailcall = false;
+ { ap_tailcall = Default_tailcall;
ap_loc = loc;
ap_func = Lazy.force code_force_lazy;
ap_args = [ arg ];
tables (~ 250 elts); conditionals are better *)
inline_lazy_force_cond arg loc
-let make_lazy_matching def = function
- | [] -> fatal_error "Matching.make_lazy_matching"
- | (arg, _mut) :: argl ->
- { cases = [];
- args = (inline_lazy_force arg Loc_unknown, Strict) :: argl;
- default = Default_environment.specialize matcher_lazy def
- }
+let get_expr_args_lazy ~scopes head (arg, _mut) rem =
+ let loc = head_loc ~scopes head in
+ (inline_lazy_force arg loc, Strict) :: rem
-let divide_lazy p ctx pm =
- divide_line (Context.specialize p) make_lazy_matching get_arg_lazy p ctx pm
+let divide_lazy ~scopes head ctx pm =
+ divide_line (Context.specialize head)
+ (get_expr_args_lazy ~scopes)
+ get_pat_args_lazy
+ head ctx pm
(* Matching against a tuple pattern *)
-let get_args_tuple arity p rem =
+let get_pat_args_tuple arity p rem =
match p with
- | { pat_desc = Tpat_any } -> omegas arity @ rem
+ | { pat_desc = Tpat_any } -> Patterns.omegas arity @ rem
| { pat_desc = Tpat_tuple args } -> args @ rem
| _ -> assert false
-let matcher_tuple arity p rem =
- match p.pat_desc with
- | Tpat_or (_, _, _) -> raise OrPat
- | Tpat_any
- | Tpat_var _ ->
- omegas arity @ rem
- | Tpat_tuple args when List.length args = arity -> args @ rem
- | _ -> raise NoMatch
-
-let make_tuple_matching loc arity def = function
- | [] -> fatal_error "Matching.make_tuple_matching"
- | (arg, _mut) :: argl ->
- let rec make_args pos =
- if pos >= arity then
- argl
- else
- (Lprim (Pfield pos, [ arg ], loc), Alias) :: make_args (pos + 1)
- in
- { cases = [];
- args = make_args 0;
- default = Default_environment.specialize (matcher_tuple arity) def
- }
+let get_expr_args_tuple ~scopes head (arg, _mut) rem =
+ let loc = head_loc ~scopes head in
+ let arity = Patterns.Head.arity head in
+ let rec make_args pos =
+ if pos >= arity then
+ rem
+ else
+ (Lprim (Pfield pos, [ arg ], loc), Alias) :: make_args (pos + 1)
+ in
+ make_args 0
-let divide_tuple ~scopes arity p ctx pm =
- divide_line (Context.specialize p)
- (make_tuple_matching (of_location ~scopes p.pat_loc) arity)
- (get_args_tuple arity) p ctx pm
+let divide_tuple ~scopes head ctx pm =
+ let arity = Patterns.Head.arity head in
+ divide_line (Context.specialize head)
+ (get_expr_args_tuple ~scopes)
+ (get_pat_args_tuple arity)
+ head ctx pm
(* Matching against a record pattern *)
let record_matching_line num_fields lbl_pat_list =
- let patv = Array.make num_fields omega in
+ let patv = Array.make num_fields Patterns.omega in
List.iter (fun (_, lbl, pat) -> patv.(lbl.lbl_pos) <- pat) lbl_pat_list;
Array.to_list patv
-let get_args_record num_fields p rem =
+let get_pat_args_record num_fields p rem =
match p with
| { pat_desc = Tpat_any } -> record_matching_line num_fields [] @ rem
| { pat_desc = Tpat_record (lbl_pat_list, _) } ->
record_matching_line num_fields lbl_pat_list @ rem
| _ -> assert false
-let matcher_record num_fields p rem =
- match p.pat_desc with
- | Tpat_or (_, _, _) -> raise OrPat
- | Tpat_any
- | Tpat_var _ ->
- record_matching_line num_fields [] @ rem
- | Tpat_record ([], _) when num_fields = 0 -> rem
- | Tpat_record (((_, lbl, _) :: _ as lbl_pat_list), _)
- when Array.length lbl.lbl_all = num_fields ->
- record_matching_line num_fields lbl_pat_list @ rem
- | _ -> raise NoMatch
-
-let make_record_matching loc all_labels def = function
- | [] -> fatal_error "Matching.make_record_matching"
- | (arg, _mut) :: argl ->
- let rec make_args pos =
- if pos >= Array.length all_labels then
- argl
- else
- let lbl = all_labels.(pos) in
- let access =
- match lbl.lbl_repres with
- | Record_regular
- | Record_inlined _ ->
- Lprim (Pfield lbl.lbl_pos, [ arg ], loc)
- | Record_unboxed _ -> arg
- | Record_float -> Lprim (Pfloatfield lbl.lbl_pos, [ arg ], loc)
- | Record_extension _ ->
- Lprim (Pfield (lbl.lbl_pos + 1), [ arg ], loc)
- in
- let str =
- match lbl.lbl_mut with
- | Immutable -> Alias
- | Mutable -> StrictOpt
- in
- (access, str) :: make_args (pos + 1)
+let get_expr_args_record ~scopes head (arg, _mut) rem =
+ let loc = head_loc ~scopes head in
+ let all_labels =
+ let open Patterns.Head in
+ match head.pat_desc with
+ | Record (lbl :: _) -> lbl.lbl_all
+ | Record []
+ | _ ->
+ assert false
+ in
+ let rec make_args pos =
+ if pos >= Array.length all_labels then
+ rem
+ else
+ let lbl = all_labels.(pos) in
+ let access =
+ match lbl.lbl_repres with
+ | Record_regular
+ | Record_inlined _ ->
+ Lprim (Pfield lbl.lbl_pos, [ arg ], loc)
+ | Record_unboxed _ -> arg
+ | Record_float -> Lprim (Pfloatfield lbl.lbl_pos, [ arg ], loc)
+ | Record_extension _ -> Lprim (Pfield (lbl.lbl_pos + 1), [ arg ], loc)
in
- let nfields = Array.length all_labels in
- let def = Default_environment.specialize (matcher_record nfields) def in
- { cases = []; args = make_args 0; default = def }
-
-let divide_record ~scopes all_labels p ctx pm =
- let get_args = get_args_record (Array.length all_labels) in
- divide_line (Context.specialize p)
- (make_record_matching (of_location ~scopes p.pat_loc) all_labels)
- get_args p ctx pm
+ let str =
+ match lbl.lbl_mut with
+ | Immutable -> Alias
+ | Mutable -> StrictOpt
+ in
+ (access, str) :: make_args (pos + 1)
+ in
+ make_args 0
+
+let divide_record all_labels ~scopes head ctx pm =
+ (* There is some redundancy in the expansions here, [head] is
+ expanded here and again in the matcher. It would be
+ nicer to have a type-level distinction between expanded heads
+ and non-expanded heads, to be able to reason confidently on
+ when expansions must happen. *)
+ let head = expand_record_head head in
+ divide_line (Context.specialize head)
+ (get_expr_args_record ~scopes)
+ (get_pat_args_record (Array.length all_labels))
+ head ctx pm
(* Matching against an array pattern *)
| { pat_desc = Tpat_array patl } -> List.length patl
| _ -> assert false
-let get_args_array p rem =
+let get_pat_args_array p rem =
match p with
| { pat_desc = Tpat_array patl } -> patl @ rem
| _ -> assert false
-let matcher_array len p rem =
- match p.pat_desc with
- | Tpat_or (_, _, _) -> raise OrPat
- | Tpat_array args when List.length args = len -> args @ rem
- | Tpat_any -> Parmatch.omegas len @ rem
- | _ -> raise NoMatch
-
-let make_array_matching ~scopes kind p def ctx = function
- | [] -> fatal_error "Matching.make_array_matching"
- | (arg, _mut) :: argl ->
- let len = get_key_array p in
- let rec make_args pos =
- if pos >= len then
- argl
- else
- ( Lprim
- ( Parrayrefu kind,
- [ arg; Lconst (Const_base (Const_int pos)) ],
- (of_location ~scopes p.pat_loc) ),
- StrictOpt )
- :: make_args (pos + 1)
- in
- let def = Default_environment.specialize (matcher_array len) def
- and ctx = Context.specialize p ctx in
- { pm = { cases = []; args = make_args 0; default = def };
- ctx;
- discr = normalize_pat p
- }
+let get_expr_args_array ~scopes kind head (arg, _mut) rem =
+ let len =
+ let open Patterns.Head in
+ match head.pat_desc with
+ | Array len -> len
+ | _ -> assert false
+ in
+ let loc = head_loc ~scopes head in
+ let rec make_args pos =
+ if pos >= len then
+ rem
+ else
+ ( Lprim
+ (Parrayrefu kind, [ arg; Lconst (Const_base (Const_int pos)) ], loc),
+ StrictOpt )
+ :: make_args (pos + 1)
+ in
+ make_args 0
let divide_array ~scopes kind ctx pm =
- divide (make_array_matching ~scopes kind) ( = )
- get_key_array get_args_array ctx pm
+ divide
+ (get_expr_args_array ~scopes kind)
+ ( = )
+ get_key_array get_pat_args_array
+ ctx pm
(*
Specific string test sequence
| pat :: rem -> { pat with pat_desc = Tpat_or (pat, list_as_pat rem, None) }
let complete_pats_constrs = function
- | p :: _ as pats ->
- List.map (pat_of_constr p)
- (complete_constrs p (List.map get_key_constr pats))
+ | constr :: _ as constrs ->
+ let tag_of_constr constr =
+ constr.pat_desc.cstr_tag in
+ let pat_of_constr cstr =
+ let open Patterns.Head in
+ to_omega_pattern { constr with pat_desc = Construct cstr } in
+ List.map pat_of_constr
+ (complete_constrs constr (List.map tag_of_constr constrs))
| _ -> assert false
(*
let split_cases tag_lambda_list =
let rec split_rec = function
| [] -> ([], [])
- | (cstr, act) :: rem -> (
+ | (cstr_tag, act) :: rem -> (
let consts, nonconsts = split_rec rem in
- match cstr with
+ match cstr_tag with
| Cstr_constant n -> ((n, act) :: consts, nonconsts)
| Cstr_block n -> (consts, (n, act) :: nonconsts)
| Cstr_unboxed -> (consts, (0, act) :: nonconsts)
let split_extension_cases tag_lambda_list =
let rec split_rec = function
| [] -> ([], [])
- | (cstr, act) :: rem -> (
+ | (cstr_tag, act) :: rem -> (
let consts, nonconsts = split_rec rem in
- match cstr with
+ match cstr_tag with
| Cstr_extension (path, true) -> ((path, act) :: consts, nonconsts)
| Cstr_extension (path, false) -> (consts, (path, act) :: nonconsts)
| _ -> assert false
split_rec tag_lambda_list
let combine_constructor loc arg pat_env cstr partial ctx def
- (tag_lambda_list, total1, pats) =
+ (descr_lambda_list, total1, pats) =
+ let tag_lambda (cstr, act) = (cstr.cstr_tag, act) in
match cstr.cstr_tag with
| Cstr_extension _ ->
(* Special cases for extensions *)
let fail, local_jumps = mk_failaction_neg partial ctx def in
let lambda1 =
- let consts, nonconsts = split_extension_cases tag_lambda_list in
+ let consts, nonconsts =
+ split_extension_cases (List.map tag_lambda descr_lambda_list) in
let default, consts, nonconsts =
match fail with
| None -> (
(lambda1, Jumps.union local_jumps total1)
| _ ->
(* Regular concrete type *)
- let ncases = List.length tag_lambda_list
+ let ncases = List.length descr_lambda_list
and nconstrs = cstr.cstr_consts + cstr.cstr_nonconsts in
let sig_complete = ncases = nconstrs in
let fail_opt, fails, local_jumps =
if sig_complete then
(None, [], Jumps.empty)
else
- mk_failaction_pos partial pats ctx def
+ let constrs =
+ List.map2 (fun (constr, _act) p -> { p with pat_desc = constr })
+ descr_lambda_list pats in
+ mk_failaction_pos partial constrs ctx def
in
- let tag_lambda_list = fails @ tag_lambda_list in
- let consts, nonconsts = split_cases tag_lambda_list in
+ let descr_lambda_list = fails @ descr_lambda_list in
+ let consts, nonconsts =
+ split_cases (List.map tag_lambda descr_lambda_list) in
let lambda1 =
- match (fail_opt, same_actions tag_lambda_list) with
+ match (fail_opt, same_actions descr_lambda_list) with
| None, Some act -> act (* Identical actions, no failure *)
| _ -> (
match
| (key, cell) :: rem -> (
if Context.is_empty cell.ctx then
c_rec totals rem
- else
- try
- let lambda1, total1 = compile_fun cell.ctx cell.pm in
+ else begin
+ match compile_fun cell.ctx cell.pm with
+ | exception Unused -> c_rec totals rem
+ | lambda1, total1 ->
let c_rem, total, new_discrs =
c_rec (Jumps.map Context.combine total1 :: totals) rem
in
- ((key, lambda1) :: c_rem, total, cell.discr :: new_discrs)
- with Unused -> c_rec totals rem
+ ( (key, lambda1) :: c_rem,
+ total,
+ Patterns.Head.to_omega_pattern cell.discr :: new_discrs )
+ end
)
in
c_rec [] division
let rec do_rec r total_r = function
| [] -> (r, total_r)
| { provenance = mat; exit = i; vars; pm } :: rem -> (
- try
- let ctx = Context.select_columns mat ctx in
- let handler_i, total_i = compile_fun ctx pm in
- match raw_action r with
+ let ctx = Context.select_columns mat ctx in
+ match compile_fun ctx pm with
+ | exception Unused ->
+ do_rec (Lstaticcatch (r, (i, vars), lambda_unit)) total_r rem
+ | handler_i, total_i ->
+ begin match raw_action r with
| Lstaticraise (j, args) ->
if i = j then
( List.fold_right2
(Jumps.union (Jumps.remove i total_r)
(Jumps.map (Context.rshift_num (ncols mat)) total_i))
rem
- with Unused ->
- do_rec (Lstaticcatch (r, (i, vars), lambda_unit)) total_r rem
+ end
)
in
do_rec lambda1 total1 to_catch
let ctx_i, total_rem = Jumps.extract i total_body in
if Context.is_empty ctx_i then
c_rec body total_body rem
- else
- try
- let li, total_i =
- comp_fun
- ( match rem with
- | [] -> partial
- | _ -> Partial
- )
- ctx_i pm
- in
+ else begin
+ let partial = match rem with
+ | [] -> partial
+ | _ -> Partial
+ in
+ match comp_fun partial ctx_i pm with
+ | li, total_i ->
c_rec
(Lstaticcatch (body, (i, []), li))
(Jumps.union total_i total_rem)
rem
- with Unused ->
- c_rec (Lstaticcatch (body, (i, []), lambda_unit)) total_rem rem
+ | exception Unused ->
+ c_rec
+ (Lstaticcatch (body, (i, []), lambda_unit))
+ total_rem rem
+ end
)
in
- try
- let first_lam, total = comp_fun Partial ctx first_match in
+ match comp_fun Partial ctx first_match with
+ | first_lam, total ->
c_rec first_lam total rem
- with Unused -> (
+ | exception Unused -> (
match next_matchs with
| [] -> raise Unused
| (_, x) :: xs -> comp_match_handlers comp_fun partial ctx x xs
(event_branch repr action, Jumps.empty)
| nonempty_cases ->
compile_match_nonempty ~scopes repr partial ctx
- { m with cases = List.map Non_empty_clause.of_initial nonempty_cases }
+ { m with cases = map_on_rows Non_empty_row.of_initial nonempty_cases }
and compile_match_nonempty ~scopes repr partial ctx
- (m : Typedtree.pattern Non_empty_clause.t pattern_matching) =
+ (m : Typedtree.pattern Non_empty_row.t clause pattern_matching) =
match m with
| { cases = []; args = [] } -> comp_exit ctx m
| { args = (arg, str) :: argl } ->
let cases = List.map (half_simplify_nonempty ~arg:newarg) m.cases in
let m = { m with args; cases } in
let first_match, rem =
- split_and_precompile_half_simplified ~arg:(Some v) m in
+ split_and_precompile_half_simplified ~arg_id:(Some v) m in
combine_handlers ~scopes repr partial ctx (v, str, arg) first_match rem
| _ -> assert false
assert false
in
let ph = what_is_cases pm.cases in
- let pomega = Pattern_head.to_omega_pattern ph in
- let ploc = Pattern_head.loc ph in
- match Pattern_head.desc ph with
+ let pomega = Patterns.Head.to_omega_pattern ph in
+ let ploc = head_loc ~scopes ph in
+ let open Patterns.Head in
+ match ph.pat_desc with
| Any ->
- compile_no_test ~scopes divide_var Context.rshift repr partial ctx pm
- | Tuple l ->
- compile_no_test ~scopes (divide_tuple ~scopes l pomega)
+ compile_no_test ~scopes
+ divide_var
+ Context.rshift repr partial ctx pm
+ | Tuple _ ->
+ compile_no_test ~scopes
+ (divide_tuple ~scopes ph)
Context.combine repr partial ctx pm
| Record [] -> assert false
| Record (lbl :: _) ->
compile_no_test ~scopes
- (divide_record ~scopes lbl.lbl_all pomega)
+ (divide_record ~scopes lbl.lbl_all ph)
Context.combine repr partial ctx pm
| Constant cst ->
compile_test
(compile_match ~scopes repr partial)
partial divide_constant
- (combine_constant (of_location ~scopes ploc) arg cst partial)
+ (combine_constant ploc arg cst partial)
ctx pm
| Construct cstr ->
compile_test
(compile_match ~scopes repr partial)
partial (divide_constructor ~scopes)
- (combine_constructor (of_location ~scopes ploc) arg
- (Pattern_head.env ph) cstr partial)
+ (combine_constructor ploc arg ph.pat_env cstr partial)
ctx pm
| Array _ ->
let kind = Typeopt.array_pattern_kind pomega in
compile_test
(compile_match ~scopes repr partial)
partial (divide_array ~scopes kind)
- (combine_array (of_location ~scopes ploc) arg kind partial)
+ (combine_array ploc arg kind partial)
ctx pm
| Lazy ->
compile_no_test ~scopes
- (divide_lazy pomega)
+ (divide_lazy ~scopes ph)
Context.combine repr partial ctx pm
| Variant { cstr_row = row } ->
compile_test
(compile_match ~scopes repr partial)
partial (divide_variant ~scopes !row)
- (combine_variant (of_location ~scopes ploc) !row arg partial)
+ (combine_variant ploc !row arg partial)
ctx pm
)
| PmVar { inside = pmh } ->
(* have toplevel handler when appropriate *)
-let check_total total lambda i handler_fun =
+type failer_kind =
+ | Raise_match_failure
+ | Reraise_noloc of lambda
+
+let failure_handler ~scopes loc ~failer () =
+ match failer with
+ | Reraise_noloc exn_lam ->
+ Lprim (Praise Raise_reraise, [ exn_lam ], Scoped_location.Loc_unknown)
+ | Raise_match_failure ->
+ let sloc = Scoped_location.of_location ~scopes loc in
+ let slot =
+ transl_extension_path sloc
+ Env.initial_safe_string Predef.path_match_failure
+ in
+ let fname, line, char =
+ Location.get_pos_info loc.Location.loc_start in
+ Lprim
+ ( Praise Raise_regular,
+ [ Lprim
+ ( Pmakeblock (0, Immutable, None),
+ [ slot;
+ Lconst
+ (Const_block
+ ( 0,
+ [ Const_base (Const_string (fname, loc, None));
+ Const_base (Const_int line);
+ Const_base (Const_int char)
+ ] ))
+ ],
+ sloc )
+ ],
+ sloc )
+
+let check_total ~scopes loc ~failer total lambda i =
if Jumps.is_empty total then
lambda
else
- Lstaticcatch (lambda, (i, []), handler_fun ())
+ Lstaticcatch (lambda, (i, []),
+ failure_handler ~scopes loc ~failer ())
-let compile_matching ~scopes repr handler_fun arg pat_act_list partial =
+let compile_matching ~scopes loc ~failer repr arg pat_act_list partial =
let partial = check_partial pat_act_list partial in
match partial with
| Partial -> (
let pm =
{ cases = List.map (fun (pat, act) -> ([ pat ], act)) pat_act_list;
args = [ (arg, Strict) ];
- default = Default_environment.(cons [ [ omega ] ] raise_num empty)
+ default =
+ Default_environment.(cons [ [ Patterns.omega ] ] raise_num empty)
}
in
try
let lambda, total =
compile_match ~scopes repr partial (Context.start 1) pm in
- check_total total lambda raise_num handler_fun
+ check_total ~scopes loc ~failer total lambda raise_num
with Unused -> assert false
(* ; handler_fun() *)
)
assert (Jumps.is_empty total);
lambda
-let partial_function ~scopes loc () =
- let sloc = of_location ~scopes loc in
- let slot =
- transl_extension_path sloc Env.initial_safe_string Predef.path_match_failure
- in
- let fname, line, char =
- Location.get_pos_info loc.Location.loc_start in
- Lprim
- ( Praise Raise_regular,
- [ Lprim
- ( Pmakeblock (0, Immutable, None),
- [ slot;
- Lconst
- (Const_block
- ( 0,
- [ Const_base (Const_string (fname, loc, None));
- Const_base (Const_int line);
- Const_base (Const_int char)
- ] ))
- ],
- sloc )
- ],
- sloc )
-
let for_function ~scopes loc repr param pat_act_list partial =
- let f () = partial_function ~scopes loc () in
- compile_matching ~scopes repr f param pat_act_list partial
+ compile_matching ~scopes loc ~failer:Raise_match_failure
+ repr param pat_act_list partial
(* In the following two cases, exhaustiveness info is not available! *)
-let for_trywith ~scopes param pat_act_list =
- compile_matching ~scopes None
- (fun () -> Lprim (Praise Raise_reraise, [ param ], Loc_unknown))
- param pat_act_list Partial
+let for_trywith ~scopes loc param pat_act_list =
+ (* Note: the failure action of [for_trywith] corresponds
+ to an exception that is not matched by a try..with handler,
+ and is thus reraised for the next handler in the stack.
+
+ It is important to *not* include location information in
+ the reraise (hence the [_noloc]) to avoid seeing this
+ silent reraise in exception backtraces. *)
+ compile_matching ~scopes loc ~failer:(Reraise_noloc param)
+ None param pat_act_list Partial
let simple_for_let ~scopes loc param pat body =
- compile_matching ~scopes None (partial_function ~scopes loc)
- param [ (pat, body) ] Partial
+ compile_matching ~scopes loc ~failer:Raise_match_failure
+ None param [ (pat, body) ] Partial
(* Optimize binding of immediate tuples
let for_tupled_function ~scopes loc paraml pats_act_list partial =
let partial = check_partial_list pats_act_list partial in
let raise_num = next_raise_count () in
- let omegas = [ List.map (fun _ -> omega) paraml ] in
+ let omega_params = [ Patterns.omega_list paraml ] in
let pm =
{ cases = pats_act_list;
args = List.map (fun id -> (Lvar id, Strict)) paraml;
- default = Default_environment.(cons omegas raise_num empty)
+ default = Default_environment.(cons omega_params raise_num empty)
}
in
try
compile_match ~scopes None partial
(Context.start (List.length paraml)) pm
in
- check_total total lambda raise_num (partial_function ~scopes loc)
- with Unused -> partial_function ~scopes loc ()
+ check_total ~scopes loc ~failer:Raise_match_failure
+ total lambda raise_num
+ with Unused ->
+ failure_handler ~scopes loc ~failer:Raise_match_failure ()
let flatten_pattern size p =
match p.pat_desc with
| Tpat_tuple args -> args
- | Tpat_any -> omegas size
+ | Tpat_any -> Patterns.omegas size
| _ -> raise Cannot_flatten
+let flatten_simple_pattern size (p : Simple.pattern) =
+ match p.pat_desc with
+ | `Tuple args -> args
+ | `Any -> Patterns.omegas size
+ | `Array _
+ | `Variant _
+ | `Record _
+ | `Lazy _
+ | `Construct _
+ | `Constant _ ->
+ (* All calls to this function originate from [do_for_multiple_match],
+ where we know that the scrutinee is a tuple literal.
+
+ Since the PM is well typed, none of these cases are possible. *)
+ let msg =
+ Format.fprintf Format.str_formatter
+ "Matching.flatten_pattern: got '%a'" top_pretty (General.erase p);
+ Format.flush_str_formatter ()
+ in
+ fatal_error msg
+
let flatten_cases size cases =
List.map
(function
| (p, []), action -> (
- match flatten_pattern size (General.erase p) with
+ match flatten_simple_pattern size p with
| p :: ps -> ((p, ps), action)
| [] -> assert false
)
type pm_flattened =
| FPmOr of pattern pm_or_compiled
- | FPm of pattern Non_empty_clause.t pattern_matching
+ | FPm of pattern Non_empty_row.t clause pattern_matching
let flatten_precompiled size args pmh =
match pmh with
match partial with
| Partial ->
let raise_num = next_raise_count () in
- (raise_num, Default_environment.(cons [ [ omega ] ] raise_num empty))
+ ( raise_num,
+ Default_environment.(cons [ [ Patterns.omega ] ] raise_num empty)
+ )
| Total -> (-1, Default_environment.empty)
in
- let loc = of_location ~scopes loc in
+ let loc = Scoped_location.of_location ~scopes loc in
let arg = Lprim (Pmakeblock (0, Immutable, None), paraml, loc) in
( raise_num,
arg,
} )
in
try
- try
- (* Once for checking that compilation is possible *)
- let next, nexts =
- split_and_precompile ~arg_id:None ~arg_lambda:arg pm1
- in
- let size = List.length paraml
- and idl = List.map (fun _ -> Ident.create_local "*match*") paraml in
- let args = List.map (fun id -> (Lvar id, Alias)) idl in
- let flat_next = flatten_precompiled size args next
- and flat_nexts =
- List.map (fun (e, pm) -> (e, flatten_precompiled size args pm)) nexts
- in
- let lam, total =
- comp_match_handlers (compile_flattened ~scopes repr) partial
- (Context.start size) flat_next flat_nexts
- in
- List.fold_right2 (bind Strict) idl paraml
- ( match partial with
+ match split_and_precompile ~arg_id:None ~arg_lambda:arg pm1 with
+ | exception Cannot_flatten ->
+ (* One pattern binds the whole tuple, flattening is not possible.
+ We need to allocate the scrutinee. *)
+ let lambda, total =
+ compile_match ~scopes None partial (Context.start 1) pm1 in
+ begin match partial with
| Partial ->
- check_total total lam raise_num (partial_function ~scopes loc)
+ check_total ~scopes loc ~failer:Raise_match_failure
+ total lambda raise_num
| Total ->
assert (Jumps.is_empty total);
- lam
- )
- with Cannot_flatten -> (
- let lambda, total =
- compile_match ~scopes None partial (Context.start 1) pm1 in
- match partial with
- | Partial ->
- check_total total lambda raise_num (partial_function ~scopes loc)
- | Total ->
- assert (Jumps.is_empty total);
- lambda
- )
+ lambda
+ end
+ | next, nexts ->
+ let size = List.length paraml
+ and idl = List.map (fun _ -> Ident.create_local "*match*") paraml in
+ let args = List.map (fun id -> (Lvar id, Alias)) idl in
+ let flat_next = flatten_precompiled size args next
+ and flat_nexts =
+ List.map (fun (e, pm) -> (e, flatten_precompiled size args pm)) nexts
+ in
+ let lam, total =
+ comp_match_handlers (compile_flattened ~scopes repr) partial
+ (Context.start size) flat_next flat_nexts
+ in
+ List.fold_right2 (bind Strict) idl paraml
+ ( match partial with
+ | Partial ->
+ check_total ~scopes loc ~failer:Raise_match_failure
+ total lam raise_num
+ | Total ->
+ assert (Jumps.is_empty total);
+ lam
+ )
with Unused -> assert false
(* ; partial_function loc () *)
int ref option -> lambda -> (pattern * lambda) list -> partial ->
lambda
val for_trywith:
- scopes:scopes ->
+ scopes:scopes -> Location.t ->
lambda -> (pattern * lambda) list ->
lambda
val for_let:
| Const_base(Const_int32 n) -> fprintf ppf "%lil" n
| Const_base(Const_int64 n) -> fprintf ppf "%LiL" n
| Const_base(Const_nativeint n) -> fprintf ppf "%nin" n
- | Const_pointer n -> fprintf ppf "%ia" n
| Const_block(tag, []) ->
fprintf ppf "[%i]" tag
| Const_block(tag, sc1::scl) ->
| Never_local -> fprintf ppf "never_local@ "
end
-let apply_tailcall_attribute ppf tailcall =
- if tailcall then
- fprintf ppf " @@tailcall"
+let apply_tailcall_attribute ppf = function
+ | Default_tailcall -> ()
+ | Tailcall_expectation true ->
+ fprintf ppf " tailcall"
+ | Tailcall_expectation false ->
+ fprintf ppf " tailcall(false)"
let apply_inlined_attribute ppf = function
| Default_inline -> ()
let lams ppf largs =
List.iter (fun l -> fprintf ppf "@ %a" lam l) largs in
fprintf ppf "@[<2>(apply@ %a%a%a%a%a)@]" lam ap.ap_func lams ap.ap_args
- apply_tailcall_attribute ap.ap_should_be_tailcall
+ apply_tailcall_attribute ap.ap_tailcall
apply_inlined_attribute ap.ap_inlined
apply_specialised_attribute ap.ap_specialised
| Lfunction{kind; params; return; body; attr} ->
| Prevapply, [x; Lapply ap]
| Prevapply, [x; Levent (Lapply ap,_)] ->
Lapply {ap with ap_args = ap.ap_args @ [x]; ap_loc = loc}
- | Prevapply, [x; f] -> Lapply {ap_should_be_tailcall=false;
- ap_loc=loc;
- ap_func=f;
- ap_args=[x];
- ap_inlined=Default_inline;
- ap_specialised=Default_specialise}
-
+ | Prevapply, [x; f] ->
+ Lapply {
+ ap_loc=loc;
+ ap_func=f;
+ ap_args=[x];
+ ap_tailcall=Default_tailcall;
+ ap_inlined=Default_inline;
+ ap_specialised=Default_specialise;
+ }
(* Simplify %apply, for n-ary functions with n > 1 *)
| Pdirapply, [Lapply ap; x]
| Pdirapply, [Levent (Lapply ap,_); x] ->
Lapply {ap with ap_args = ap.ap_args @ [x]; ap_loc = loc}
- | Pdirapply, [f; x] -> Lapply {ap_should_be_tailcall=false;
- ap_loc=loc;
- ap_func=f;
- ap_args=[x];
- ap_inlined=Default_inline;
- ap_specialised=Default_specialise}
+ | Pdirapply, [f; x] ->
+ Lapply {
+ ap_loc=loc;
+ ap_func=f;
+ ap_args=[x];
+ ap_tailcall=Default_tailcall;
+ ap_inlined=Default_inline;
+ ap_specialised=Default_specialise;
+ }
(* Simplify %identity *)
| Pidentity, [e] -> e
| Lfunction{kind; params; return=return1; body = l; attr; loc} ->
begin match simplif l with
Lfunction{kind=Curried; params=params'; return=return2; body; attr; loc}
- when kind = Curried && optimize ->
+ when kind = Curried && optimize &&
+ List.length params + List.length params' <= Lambda.max_arity() ->
(* The return type is the type of the value returned after
applying all the parameters to the function. The return
type of the merged function taking [params @ params'] as
(* Tail call info in annotation files *)
-let is_tail_native_heuristic : (int -> bool) ref =
- ref (fun _ -> true)
-
let rec emit_tail_infos is_tail lambda =
match lambda with
| Lvar _ -> ()
| Lconst _ -> ()
| Lapply ap ->
- if ap.ap_should_be_tailcall
- && not is_tail
- && Warnings.is_active Warnings.Expect_tailcall
- then Location.prerr_warning (to_location ap.ap_loc)
- Warnings.Expect_tailcall;
+ begin
+ (* Note: is_tail does not take backend-specific logic into
+ account (maximum number of parameters, etc.) so it may
+ over-approximate tail-callness.
+
+ Trying to do something more fine-grained would result in
+ different warnings depending on whether the native or
+ bytecode compiler is used. *)
+ let maybe_warn ~is_tail ~expect_tail =
+ if is_tail <> expect_tail then
+ Location.prerr_warning (to_location ap.ap_loc)
+ (Warnings.Wrong_tailcall_expectation expect_tail) in
+ match ap.ap_tailcall with
+ | Default_tailcall -> ()
+ | Tailcall_expectation expect_tail ->
+ maybe_warn ~is_tail ~expect_tail
+ end;
emit_tail_infos false ap.ap_func;
list_emit_tail_infos false ap.ap_args
| Lfunction {body = lam} ->
ap_func = Lvar inner_id;
ap_args = args;
ap_loc = Loc_unknown;
- ap_should_be_tailcall = false;
+ ap_tailcall = Default_tailcall;
ap_inlined = Default_inline;
ap_specialised = Default_specialise;
}
|> simplify_exits
|> simplify_lets
in
- if !Clflags.annotations || Warnings.is_active Warnings.Expect_tailcall
- then emit_tail_infos true lam;
+ if !Clflags.annotations
+ || Warnings.is_active (Warnings.Wrong_tailcall_expectation true)
+ then emit_tail_infos true lam;
lam
-> attr:function_attribute
-> loc:Lambda.scoped_location
-> (Ident.t * lambda) list
-
-(* To be filled by asmcomp/selectgen.ml *)
-val is_tail_native_heuristic: (int -> bool) ref
- (* # arguments -> can tailcall *)
| {txt="inline"|"ocaml.inline"|"inlined"|"ocaml.inlined"} -> false
| _ -> assert false
-let get_id_payload =
+let get_payload get_from_exp =
let open Parsetree in
function
- | PStr [] -> Some ""
- | PStr [{pstr_desc = Pstr_eval ({pexp_desc},[])}] ->
- begin match pexp_desc with
- | Pexp_ident { txt = Longident.Lident id } -> Some id
- | _ -> None
- end
- | _ -> None
+ | PStr [{pstr_desc = Pstr_eval (exp, [])}] -> get_from_exp exp
+ | _ -> Result.Error ()
+
+let get_optional_payload get_from_exp =
+ let open Parsetree in
+ function
+ | PStr [] -> Result.Ok None
+ | other -> Result.map Option.some (get_payload get_from_exp other)
+
+let get_id_from_exp =
+ let open Parsetree in
+ function
+ | { pexp_desc = Pexp_ident { txt = Longident.Lident id } } -> Result.Ok id
+ | _ -> Result.Error ()
+
+let get_int_from_exp =
+ let open Parsetree in
+ function
+ | { pexp_desc = Pexp_constant (Pconst_integer(s, None)) } ->
+ begin match Misc.Int_literal_converter.int s with
+ | n -> Result.Ok n
+ | exception (Failure _) -> Result.Error ()
+ end
+ | _ -> Result.Error ()
+
+let get_construct_from_exp =
+ let open Parsetree in
+ function
+ | { pexp_desc =
+ Pexp_construct ({ txt = Longident.Lident constr }, None) } ->
+ Result.Ok constr
+ | _ -> Result.Error ()
+
+let get_bool_from_exp exp =
+ Result.bind (get_construct_from_exp exp)
+ (function
+ | "true" -> Result.Ok true
+ | "false" -> Result.Ok false
+ | _ -> Result.Error ())
let parse_id_payload txt loc ~default ~empty cases payload =
let[@local] warn () =
Location.prerr_warning loc (Warnings.Attribute_payload (txt, msg));
default
in
- match get_id_payload payload with
- | Some "" -> empty
- | None -> warn ()
- | Some id ->
+ match get_optional_payload get_id_from_exp payload with
+ | Error () -> warn ()
+ | Ok None -> empty
+ | Ok (Some id) ->
match List.assoc_opt id cases with
| Some r -> r
| None -> warn ()
match attr with
| None -> Default_inline
| Some {Parsetree.attr_name = {txt;loc} as id; attr_payload = payload} ->
- let open Parsetree in
if is_unrolled id then begin
(* the 'unrolled' attributes must be used as [@unrolled n]. *)
let warning txt = Warnings.Attribute_payload
(txt, "It must be an integer literal")
in
- match payload with
- | PStr [{pstr_desc = Pstr_eval ({pexp_desc},[])}] -> begin
- match pexp_desc with
- | Pexp_constant (Pconst_integer(s, None)) -> begin
- try
- Unroll (Misc.Int_literal_converter.int s)
- with Failure _ ->
- Location.prerr_warning loc (warning txt);
- Default_inline
- end
- | _ ->
- Location.prerr_warning loc (warning txt);
- Default_inline
- end
- | _ ->
+ match get_payload get_int_from_exp payload with
+ | Ok n -> Unroll n
+ | Error () ->
Location.prerr_warning loc (warning txt);
Default_inline
end else
| {Parsetree.attr_name = {txt=("tailcall"|"ocaml.tailcall")}; _} -> true
| _ -> false
in
- let tailcalls, exp_attributes =
+ let tailcalls, other_attributes =
List.partition is_tailcall_attribute e.exp_attributes
in
- match tailcalls with
- | [] -> false, e
- | _ :: r ->
- begin match r with
- | [] -> ()
- | {Parsetree.attr_name = {txt;loc}; _} :: _ ->
- Location.prerr_warning loc (Warnings.Duplicated_attribute txt)
- end;
- true, { e with exp_attributes }
+ let tailcall_attribute = match tailcalls with
+ | [] -> Default_tailcall
+ | {Parsetree.attr_name = {txt; loc}; attr_payload = payload} :: r ->
+ begin match r with
+ | [] -> ()
+ | {Parsetree.attr_name = {txt;loc}; _} :: _ ->
+ Location.prerr_warning loc (Warnings.Duplicated_attribute txt)
+ end;
+ match get_optional_payload get_bool_from_exp payload with
+ | Ok (None | Some true) -> Tailcall_expectation true
+ | Ok (Some false) -> Tailcall_expectation false
+ | Error () ->
+ let msg = "Only an optional boolean literal is supported." in
+ Location.prerr_warning loc (Warnings.Attribute_payload (txt, msg));
+ Default_tailcall
+ in
+ tailcall_attribute, { e with exp_attributes = other_attributes }
let check_attribute e {Parsetree.attr_name = { txt; loc }; _} =
match txt with
val get_tailcall_attribute
: Typedtree.expression
- -> bool * Typedtree.expression
+ -> Lambda.tailcall_attribute * Typedtree.expression
val add_function_attributes
: Lambda.lambda
let lfunction params body =
if params = [] then body else
match body with
- | Lfunction {kind = Curried; params = params'; body = body'; attr; loc} ->
+ | 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;
Lapply ap
let mkappl (func, args) =
- Lapply {ap_should_be_tailcall=false;
- ap_loc=Loc_unknown;
- ap_func=func;
- ap_args=args;
- ap_inlined=Default_inline;
- ap_specialised=Default_specialise};;
+ Lapply {
+ ap_loc=Loc_unknown;
+ ap_func=func;
+ ap_args=args;
+ ap_tailcall=Default_tailcall;
+ ap_inlined=Default_inline;
+ ap_specialised=Default_specialise;
+ };;
let lsequence l1 l2 =
if l2 = lambda_unit then l1 else Lsequence(l1, l2)
let transl_label l = share (Const_immstring l)
let transl_meth_list lst =
- if lst = [] then Lconst (Const_pointer 0) else
+ if lst = [] then Lconst (const_int 0) else
share (Const_block
(0, List.map (fun lab -> Const_immstring lab) lst))
Llet (Strict, Pgenval, inh,
mkappl(oo_prim "inherits", narrow_args @
[path_lam;
- Lconst(Const_pointer(if top then 1 else 0))]),
+ Lconst(const_int (if top then 1 else 0))]),
Llet(StrictOpt, Pgenval, obj_init, lfield inh 0, cl_init)))
| _ ->
let core cl_init =
let obj_init = Ident.create_local "obj_init"
and self = Ident.create_local "self" in
let obj_init0 =
- lapply {ap_should_be_tailcall=false;
- ap_loc=Loc_unknown;
- ap_func=Lvar obj_init;
- ap_args=[Lvar self];
- ap_inlined=Default_inline;
- ap_specialised=Default_specialise}
+ lapply {
+ ap_loc=Loc_unknown;
+ ap_func=Lvar obj_init;
+ ap_args=[Lvar self];
+ ap_tailcall=Default_tailcall;
+ ap_inlined=Default_inline;
+ ap_specialised=Default_specialise;
+ }
in
let _, path_lam, obj_init' =
transl_class_rebind_0 ~scopes self obj_init0 cl vf in
| Lprim(Parrayrefu _, [Lvar s; Lvar n], _) when List.mem s self ->
"var", [Lvar n]
| Lprim(Pfield n, [Lvar e], _) when Ident.same e env ->
- "env", [Lvar env2; Lconst(Const_pointer n)]
+ "env", [Lvar env2; Lconst(const_int n)]
| Lsend(Self, met, Lvar s, [], _) when List.mem s self ->
"meth", [met]
| _ -> raise Not_found
| "send_env" -> SendEnv
| "send_meth" -> SendMeth
| _ -> assert false
- in Lconst(Const_pointer(Obj.magic tag)) :: args
+ in Lconst(const_int (Obj.magic tag)) :: args
end
open M
Text_decl _ ->
Lprim (Pmakeblock (Obj.object_tag, Immutable, None),
[Lconst (Const_base (Const_string (name, ext.ext_loc, None)));
- Lprim (prim_fresh_oo_id, [Lconst (Const_base (Const_int 0))], loc)],
+ Lprim (prim_fresh_oo_id, [Lconst (const_int 0)], loc)],
loc)
| Text_rebind(path, _lid) ->
transl_extension_path loc env path
in
if extra_args = [] then lam
else begin
- let should_be_tailcall, funct =
+ let tailcall, funct =
Translattribute.get_tailcall_attribute funct
in
let inlined, funct =
in
let e = { e with exp_desc = Texp_apply(funct, oargs) } in
event_after ~scopes e
- (transl_apply ~scopes ~should_be_tailcall ~inlined ~specialised
+ (transl_apply ~scopes ~tailcall ~inlined ~specialised
lam extra_args (of_location ~scopes e.exp_loc))
end
| Texp_apply(funct, oargs) ->
- let should_be_tailcall, funct =
+ let tailcall, funct =
Translattribute.get_tailcall_attribute funct
in
let inlined, funct =
in
let e = { e with exp_desc = Texp_apply(funct, oargs) } in
event_after ~scopes e
- (transl_apply ~scopes ~should_be_tailcall ~inlined ~specialised
+ (transl_apply ~scopes ~tailcall ~inlined ~specialised
(transl_exp ~scopes funct) oargs (of_location ~scopes e.exp_loc))
| Texp_match(arg, pat_expr_list, partial) ->
transl_match ~scopes e arg pat_expr_list partial
| Texp_try(body, pat_expr_list) ->
let id = Typecore.name_cases "exn" pat_expr_list in
Ltrywith(transl_exp ~scopes body, id,
- Matching.for_trywith ~scopes (Lvar id)
+ Matching.for_trywith ~scopes e.exp_loc (Lvar id)
(transl_cases_try ~scopes pat_expr_list))
| Texp_tuple el ->
let ll, shape = transl_list_with_shape ~scopes el in
| _ -> assert false
end else begin match cstr.cstr_tag with
Cstr_constant n ->
- Lconst(Const_pointer n)
+ Lconst(const_int n)
| Cstr_unboxed ->
(match ll with [v] -> v | _ -> assert false)
| Cstr_block n ->
| Texp_variant(l, arg) ->
let tag = Btype.hash_variant l in
begin match arg with
- None -> Lconst(Const_pointer tag)
+ None -> Lconst(const_int tag)
| Some arg ->
let lam = transl_exp ~scopes arg in
try
- Lconst(Const_block(0, [Const_base(Const_int tag);
+ Lconst(Const_block(0, [const_int tag;
extract_constant lam]))
with Not_constant ->
Lprim(Pmakeblock(0, Immutable, None),
- [Lconst(Const_base(Const_int tag)); lam],
+ [Lconst(const_int tag); lam],
of_location ~scopes e.exp_loc)
end
| Texp_record {fields; representation; extended_expression} ->
event_after ~scopes e lam
| Texp_new (cl, {Location.loc=loc}, _) ->
let loc = of_location ~scopes loc in
- Lapply{ap_should_be_tailcall=false;
- ap_loc=loc;
- ap_func=
- Lprim(Pfield 0, [transl_class_path loc e.exp_env cl], loc);
- ap_args=[lambda_unit];
- ap_inlined=Default_inline;
- ap_specialised=Default_specialise}
+ Lapply{
+ ap_loc=loc;
+ ap_func=
+ Lprim(Pfield 0, [transl_class_path loc e.exp_env cl], loc);
+ ap_args=[lambda_unit];
+ ap_tailcall=Default_tailcall;
+ ap_inlined=Default_inline;
+ ap_specialised=Default_specialise;
+ }
| Texp_instvar(path_self, path, _) ->
let loc = of_location ~scopes e.exp_loc in
let self = transl_value_path loc e.exp_env path_self in
let self = transl_value_path loc e.exp_env path_self in
let cpy = Ident.create_local "copy" in
Llet(Strict, Pgenval, cpy,
- Lapply{ap_should_be_tailcall=false;
- ap_loc=Loc_unknown;
- ap_func=Translobj.oo_prim "copy";
- ap_args=[self];
- ap_inlined=Default_inline;
- ap_specialised=Default_specialise},
+ Lapply{
+ ap_loc=Loc_unknown;
+ ap_func=Translobj.oo_prim "copy";
+ ap_args=[self];
+ ap_tailcall=Default_tailcall;
+ ap_inlined=Default_inline;
+ ap_specialised=Default_specialise;
+ },
List.fold_right
(fun (path, _, expr) rem ->
let var = transl_value_path loc e.exp_env path in
List.map (fun (patl, guard, expr) -> (patl, transl_guard ~scopes guard expr))
patl_expr_list
-and transl_apply ~scopes ?(should_be_tailcall=false) ?(inlined = Default_inline)
- ?(specialised = Default_specialise) lam sargs loc =
+and transl_apply ~scopes
+ ?(tailcall=Default_tailcall)
+ ?(inlined = Default_inline)
+ ?(specialised = Default_specialise)
+ lam sargs loc
+ =
let lapply funct args =
match funct with
Lsend(k, lmet, lobj, largs, _) ->
| Lapply ap ->
Lapply {ap with ap_args = ap.ap_args @ args; ap_loc = loc}
| lexp ->
- Lapply {ap_should_be_tailcall=should_be_tailcall;
- ap_loc=loc;
- ap_func=lexp;
- ap_args=args;
- ap_inlined=inlined;
- ap_specialised=specialised;}
+ Lapply {
+ ap_loc=loc;
+ ap_func=lexp;
+ ap_args=args;
+ ap_tailcall=tailcall;
+ ap_inlined=inlined;
+ ap_specialised=specialised;
+ }
in
let rec build_apply lam args = function
(None, optional) :: l ->
sargs)
: Lambda.lambda)
-and transl_function0
- ~scopes loc return untuplify_fn repr partial (param:Ident.t) cases =
+and transl_curried_function
+ ~scopes loc return
+ repr partial (param:Ident.t) cases =
+ let max_arity = Lambda.max_arity () in
+ let rec loop ~scopes loc return ~arity partial (param:Ident.t) cases =
+ match cases with
+ [{c_lhs=pat; c_guard=None;
+ c_rhs={exp_desc =
+ Texp_function
+ { arg_label = _; param = param'; cases = cases';
+ partial = partial'; }; exp_env; exp_type;exp_loc}}]
+ when arity < max_arity ->
+ if Parmatch.inactive ~partial pat
+ then
+ let kind = value_kind pat.pat_env pat.pat_type in
+ let return_kind = function_return_value_kind exp_env exp_type in
+ let ((_, params, return), body) =
+ loop ~scopes exp_loc return_kind ~arity:(arity + 1)
+ partial' param' cases'
+ in
+ ((Curried, (param, kind) :: params, return),
+ Matching.for_function ~scopes loc None (Lvar param)
+ [pat, body] partial)
+ else begin
+ begin match partial with
+ | Total ->
+ Location.prerr_warning pat.pat_loc
+ Match_on_mutable_state_prevent_uncurry
+ | Partial -> ()
+ end;
+ transl_tupled_function ~scopes ~arity
+ loc return repr partial param cases
+ end
+ | cases ->
+ transl_tupled_function ~scopes ~arity
+ loc return repr partial param cases
+ in
+ loop ~scopes loc return ~arity:1 partial param cases
+
+and transl_tupled_function
+ ~scopes ~arity loc return
+ repr partial (param:Ident.t) cases =
match cases with
- [{c_lhs=pat; c_guard=None;
- c_rhs={exp_desc = Texp_function { arg_label = _; param = param'; cases;
- partial = partial'; }; exp_env; exp_type} as exp}]
- when Parmatch.inactive ~partial pat ->
- let kind = value_kind pat.pat_env pat.pat_type in
- let return_kind = function_return_value_kind exp_env exp_type in
- let ((_, params, return), body) =
- transl_function0 ~scopes exp.exp_loc return_kind false
- repr partial' param' cases
- in
- ((Curried, (param, kind) :: params, return),
- Matching.for_function ~scopes loc None (Lvar param)
- [pat, body] partial)
- | {c_lhs={pat_desc = Tpat_tuple pl}} :: _ when untuplify_fn ->
+ | {c_lhs={pat_desc = Tpat_tuple pl}} :: _
+ when !Clflags.native_code
+ && arity = 1
+ && List.length pl <= (Lambda.max_arity ()) ->
begin try
let size = List.length pl in
let pats_expr_list =
((Tupled, tparams, return),
Matching.for_tupled_function ~scopes loc params
(transl_tupled_cases ~scopes pats_expr_list) partial)
- with Matching.Cannot_flatten ->
- ((Curried, [param, Pgenval], return),
- Matching.for_function ~scopes loc repr (Lvar param)
- (transl_cases ~scopes cases) partial)
+ with Matching.Cannot_flatten ->
+ transl_function0 ~scopes loc return repr partial param cases
end
- | {c_lhs=pat} :: other_cases ->
- let kind =
+ | _ -> transl_function0 ~scopes loc return repr partial param cases
+
+and transl_function0
+ ~scopes loc return
+ repr partial (param:Ident.t) cases =
+ let kind =
+ match cases with
+ | [] ->
+ (* With Camlp4, a pattern matching might be empty *)
+ Pgenval
+ | {c_lhs=pat} :: other_cases ->
(* All the patterns might not share the same types. We must take the
union of the patterns types *)
List.fold_left (fun k {c_lhs=pat} ->
- Typeopt.value_kind_union k
- (value_kind pat.pat_env pat.pat_type))
+ Typeopt.value_kind_union k
+ (value_kind pat.pat_env pat.pat_type))
(value_kind pat.pat_env pat.pat_type) other_cases
- in
- ((Curried, [param, kind], return),
- Matching.for_function ~scopes loc repr (Lvar param)
- (transl_cases ~scopes cases) partial)
- | [] ->
- (* With Camlp4, a pattern matching might be empty *)
- ((Curried, [param, Pgenval], return),
- Matching.for_function ~scopes loc repr (Lvar param)
- (transl_cases ~scopes cases) partial)
+ in
+ ((Curried, [param, kind], return),
+ Matching.for_function ~scopes loc repr (Lvar param)
+ (transl_cases ~scopes cases) partial)
and transl_function ~scopes e param cases partial =
let ((kind, params, return), body) =
(function repr ->
let pl = push_defaults e.exp_loc [] cases partial in
let return_kind = function_return_value_kind e.exp_env e.exp_type in
- transl_function0 ~scopes e.exp_loc return_kind !Clflags.native_code
+ transl_curried_function ~scopes e.exp_loc return_kind
repr partial param pl)
in
let attr = default_function_attribute in
let static_exception_id = next_raise_count () in
Lstaticcatch
(Ltrywith (Lstaticraise (static_exception_id, body), id,
- Matching.for_trywith ~scopes (Lvar id) exn_cases),
+ Matching.for_trywith ~scopes e.exp_loc (Lvar id) exn_cases),
(static_exception_id, val_ids),
handler)
in
let exp = transl_exp ~scopes and_.bop_exp in
let lam =
bind Strict right_id exp
- (Lapply{ap_should_be_tailcall = false;
- ap_loc = of_location ~scopes and_.bop_loc;
- ap_func = op;
- ap_args=[Lvar left_id; Lvar right_id];
- ap_inlined=Default_inline;
- ap_specialised=Default_specialise})
+ (Lapply{
+ ap_loc = of_location ~scopes and_.bop_loc;
+ ap_func = op;
+ ap_args=[Lvar left_id; Lvar right_id];
+ ap_tailcall = Default_tailcall;
+ ap_inlined = Default_inline;
+ ap_specialised = Default_specialise;
+ })
in
bind Strict left_id prev_lam (loop lam rest)
in
let (kind, params, return), body =
event_function ~scopes case.c_rhs
(function repr ->
- transl_function0 ~scopes case.c_rhs.exp_loc return_kind
- !Clflags.native_code repr partial param [case])
+ transl_curried_function ~scopes case.c_rhs.exp_loc return_kind
+ repr partial param [case])
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}
in
- Lapply{ap_should_be_tailcall = false;
- ap_loc = of_location ~scopes loc;
- ap_func = op;
- ap_args=[exp; func];
- ap_inlined=Default_inline;
- ap_specialised=Default_specialise}
+ Lapply{
+ ap_loc = of_location ~scopes loc;
+ ap_func = op;
+ ap_args=[exp; func];
+ ap_tailcall = Default_tailcall;
+ ap_inlined = Default_inline;
+ ap_specialised = Default_specialise;
+ }
(* Wrapper for class compilation *)
val transl_exp: scopes:scopes -> expression -> lambda
val transl_apply: scopes:scopes
- -> ?should_be_tailcall:bool
+ -> ?tailcall:tailcall_attribute
-> ?inlined:inline_attribute
-> ?specialised:specialise_attribute
-> lambda -> (arg_label * expression option) list
loc = loc;
body = apply_coercion
loc Strict cc_res
- (Lapply{ap_should_be_tailcall=false;
- ap_loc=loc;
- ap_func=Lvar id;
- ap_args=List.rev args;
- ap_inlined=Default_inline;
- ap_specialised=Default_specialise})})
+ (Lapply{
+ ap_loc=loc;
+ ap_func=Lvar id;
+ ap_args=List.rev args;
+ 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
let (fname, line, char) = Location.get_pos_info loc.Location.loc_start in
Lconst(Const_block(0,
[Const_base(Const_string (fname, loc, None));
- Const_base(Const_int line);
- Const_base(Const_int char)]))
+ const_int line;
+ const_int char]))
exception Initialization_failure of unsafe_info
let init_v =
match Ctype.expand_head env ty with
{desc = Tarrow(_,_,_,_)} ->
- Const_pointer 0 (* camlinternalMod.Function *)
+ const_int 0 (* camlinternalMod.Function *)
| {desc = Tconstr(p, _, _)} when Path.same p Predef.path_lazy_t ->
- Const_pointer 1 (* camlinternalMod.Lazy *)
+ const_int 1 (* camlinternalMod.Lazy *)
| _ ->
let not_a_function =
Unsafe {reason=Unsafe_non_function; loc; subid }
| Sig_modtype(id, minfo, _) :: rem ->
init_shape_struct (Env.add_modtype id minfo env) rem
| Sig_class _ :: rem ->
- Const_pointer 2 (* camlinternalMod.Class *)
+ const_int 2 (* camlinternalMod.Class *)
:: init_shape_struct env rem
| Sig_class_type _ :: rem ->
init_shape_struct env rem
bind_inits rem
| (Id id, Some(loc, shape), _rhs) :: rem ->
Llet(Strict, Pgenval, id,
- Lapply{ap_should_be_tailcall=false;
- ap_loc=Loc_unknown;
- ap_func=mod_prim "init_mod";
- ap_args=[loc; shape];
- ap_inlined=Default_inline;
- ap_specialised=Default_specialise},
+ Lapply{
+ ap_loc=Loc_unknown;
+ ap_func=mod_prim "init_mod";
+ ap_args=[loc; shape];
+ ap_tailcall=Default_tailcall;
+ ap_inlined=Default_inline;
+ ap_specialised=Default_specialise;
+ },
bind_inits rem)
and bind_strict = function
[] ->
| (_, None, _rhs) :: rem ->
patch_forwards rem
| (Id id, Some(_loc, shape), rhs) :: rem ->
- Lsequence(Lapply{ap_should_be_tailcall=false;
- ap_loc=Loc_unknown;
- ap_func=mod_prim "update_mod";
- ap_args=[shape; Lvar id; rhs];
- ap_inlined=Default_inline;
- ap_specialised=Default_specialise},
- patch_forwards rem)
+ Lsequence(
+ Lapply {
+ ap_loc=Loc_unknown;
+ ap_func=mod_prim "update_mod";
+ ap_args=[shape; Lvar id; rhs];
+ ap_tailcall=Default_tailcall;
+ ap_inlined=Default_inline;
+ ap_specialised=Default_specialise;
+ },
+ patch_forwards rem)
in
bind_inits bindings
in
oo_wrap mexp.mod_env true
(apply_coercion loc Strict cc)
- (Lapply{ap_should_be_tailcall=false;
- ap_loc=loc;
- ap_func=transl_module ~scopes Tcoerce_none None funct;
- ap_args=[transl_module ~scopes ccarg None arg];
- ap_inlined=inlined_attribute;
- ap_specialised=Default_specialise})
+ (Lapply{
+ ap_loc=loc;
+ ap_func=transl_module ~scopes Tcoerce_none None funct;
+ ap_args=[transl_module ~scopes ccarg None arg];
+ ap_tailcall=Default_tailcall;
+ ap_inlined=inlined_attribute;
+ ap_specialised=Default_specialise})
| Tmod_constraint(arg, _, _, ccarg) ->
transl_module ~scopes (compose_coercions cc ccarg) rootpath arg
| Tmod_unpack(arg, _) ->
in
Llet(pure_module mb.mb_expr, Pgenval, id, module_body, body), size
end
- | Tstr_module {mb_presence=Mp_absent} ->
+ | Tstr_module ({mb_presence=Mp_absent} as mb) ->
+ List.iter (Translattribute.check_attribute_on_module mb.mb_expr)
+ mb.mb_attributes;
+ List.iter (Translattribute.check_attribute_on_module mb.mb_expr)
+ mb.mb_expr.mod_attributes;
transl_structure ~scopes loc fields cc rootpath final_env rem
| Tstr_recmodule bindings ->
let ext_fields =
primitive_declarations := [];
Translprim.clear_used_primitives ();
let module_id = Ident.create_persistent module_name in
- let scopes = [Sc_module_definition module_name] in
+ let scopes = enter_module_definition ~scopes:empty_scopes module_id in
let body, size =
Translobj.transl_label_init
(fun () -> transl_struct ~scopes Loc_unknown [] cc
transl_store ~scopes rootpath
(add_ident true id subst)
cont rem))
- | Tstr_module {mb_presence=Mp_absent} ->
+ | Tstr_module ({mb_presence=Mp_absent} as mb) ->
+ List.iter (Translattribute.check_attribute_on_module mb.mb_expr)
+ mb.mb_attributes;
+ List.iter (Translattribute.check_attribute_on_module mb.mb_expr)
+ mb.mb_expr.mod_attributes;
transl_store ~scopes rootpath subst cont rem
| Tstr_recmodule bindings ->
let ids = List.filter_map (fun mb -> mb.mb_id) bindings in
(*size, transl_label_init (transl_store_structure module_id map prims str)*)
let transl_store_phrases module_name str =
- let scopes = [Sc_module_definition module_name] in
+ let scopes =
+ enter_module_definition ~scopes:empty_scopes
+ (Ident.create_persistent module_name)
+ in
transl_store_gen ~scopes module_name (str,Tcoerce_none) true
let transl_store_implementation module_name (str, restr) =
let s = !transl_store_subst in
transl_store_subst := Ident.Map.empty;
let module_ident = Ident.create_persistent module_name in
- let scopes = [Sc_module_definition module_name] in
+ let scopes = enter_module_definition ~scopes:empty_scopes module_ident in
let (i, code) = transl_store_gen ~scopes module_name (str, restr) false in
transl_store_subst := s;
{ Lambda.main_module_block_size = i;
with Not_found -> Ident.name id
let toploop_getvalue id =
- Lapply{ap_should_be_tailcall=false;
- ap_loc=Loc_unknown;
- ap_func=Lprim(Pfield toploop_getvalue_pos,
- [Lprim(Pgetglobal toploop_ident, [], Loc_unknown)],
- Loc_unknown);
- ap_args=[Lconst(Const_base(
- Const_string (toplevel_name id, Location.none,None)))];
- ap_inlined=Default_inline;
- ap_specialised=Default_specialise}
+ Lapply{
+ ap_loc=Loc_unknown;
+ ap_func=Lprim(Pfield toploop_getvalue_pos,
+ [Lprim(Pgetglobal toploop_ident, [], Loc_unknown)],
+ Loc_unknown);
+ ap_args=[Lconst(Const_base(
+ Const_string (toplevel_name id, Location.none, None)))];
+ ap_tailcall=Default_tailcall;
+ ap_inlined=Default_inline;
+ ap_specialised=Default_specialise;
+ }
let toploop_setvalue id lam =
- Lapply{ap_should_be_tailcall=false;
- ap_loc=Loc_unknown;
- ap_func=Lprim(Pfield toploop_setvalue_pos,
- [Lprim(Pgetglobal toploop_ident, [], Loc_unknown)],
- Loc_unknown);
- ap_args=[Lconst(Const_base(
- Const_string (toplevel_name id, Location.none, None)));
- lam];
- ap_inlined=Default_inline;
- ap_specialised=Default_specialise}
+ Lapply{
+ ap_loc=Loc_unknown;
+ ap_func=Lprim(Pfield toploop_setvalue_pos,
+ [Lprim(Pgetglobal toploop_ident, [], Loc_unknown)],
+ Loc_unknown);
+ ap_args=
+ [Lconst(Const_base(
+ Const_string(toplevel_name id, Location.none, None)));
+ lam];
+ ap_tailcall=Default_tailcall;
+ ap_inlined=Default_inline;
+ ap_specialised=Default_specialise;
+ }
let toploop_setvalue_id id = toploop_setvalue id (Lvar id)
transl_module ~scopes Tcoerce_none None od.open_expr,
set_idents 0 ids)
end
+ | Tstr_module ({mb_presence=Mp_absent} as mb) ->
+ List.iter (Translattribute.check_attribute_on_module mb.mb_expr)
+ mb.mb_attributes;
+ List.iter (Translattribute.check_attribute_on_module mb.mb_expr)
+ mb.mb_expr.mod_attributes;
+ lambda_unit
| Tstr_modtype _
- | Tstr_module {mb_presence=Mp_absent}
| Tstr_type _
| Tstr_class_type _
| Tstr_attribute _ ->
let transl_toplevel_definition str =
reset_labels ();
Translprim.clear_used_primitives ();
- make_sequence (transl_toplevel_item_and_close ~scopes:[]) str.str_items
+ make_sequence
+ (transl_toplevel_item_and_close ~scopes:empty_scopes)
+ str.str_items
(* Compile the initialization code for a packed library *)
| Loc_MODULE
| Loc_LOC
| Loc_POS
+ | Loc_FUNCTION
type prim =
| Primitive of Lambda.primitive * int
"%loc_LINE", Loc Loc_LINE;
"%loc_POS", Loc Loc_POS;
"%loc_MODULE", Loc Loc_MODULE;
+ "%loc_FUNCTION", Loc Loc_FUNCTION;
"%field0", Primitive ((Pfield 0), 1);
"%field1", Primitive ((Pfield 1), 1);
"%setfield0", Primitive ((Psetfield(0, Pointer, Assignment)), 2);
| Compare, Compare_int32s -> Pcompare_bints Pint32
| Compare, Compare_int64s -> Pcompare_bints Pint64
-let lambda_of_loc kind loc =
- let loc = to_location loc in
+let lambda_of_loc kind sloc =
+ let loc = to_location sloc in
let loc_start = loc.Location.loc_start in
let (file, lnum, cnum) = Location.get_pos_info loc_start in
let file =
file lnum cnum enum in
Lconst (Const_immstring loc)
| Loc_LINE -> Lconst (Const_base (Const_int lnum))
+ | Loc_FUNCTION ->
+ let scope_name = Debuginfo.Scoped_location.string_of_scoped_location sloc in
+ Lconst (Const_immstring scope_name)
let caml_restore_raw_backtrace =
Primitive.simple ~name:"caml_restore_raw_backtrace" ~arity:2 ~alloc:false
| Primitive (prim, arity), args when arity = List.length args ->
Lprim(prim, args, loc)
| External prim, args when prim = prim_sys_argv ->
- Lprim(Pccall prim, Lconst (Const_pointer 0) :: args, loc)
+ Lprim(Pccall prim, Lconst (const_int 0) :: args, loc)
| External prim, args ->
Lprim(Pccall prim, args, loc)
| Comparison(comp, knd), ([_;_] as args) ->
loc),
Lprim(Praise Raise_reraise, [raise_arg], loc)))
| Lazy_force, [arg] ->
- Matching.inline_lazy_force arg Loc_unknown
+ Matching.inline_lazy_force arg loc
| Loc kind, [] ->
lambda_of_loc kind loc
| Loc kind, [arg] ->
ROOTDIR = ..
--include $(ROOTDIR)/Makefile.config
--include $(ROOTDIR)/Makefile.common
+include $(ROOTDIR)/Makefile.common
-CAMLYACC ?= $(ROOTDIR)/yacc/ocamlyacc
+CAMLYACC ?= $(ROOTDIR)/yacc/ocamlyacc$(EXE)
CAMLC = $(BOOT_OCAMLC) -strict-sequence -nostdlib \
-I $(ROOTDIR)/boot -use-prims $(ROOTDIR)/runtime/primitives
-CAMLOPT = $(CAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib -I $(ROOTDIR)/stdlib
+CAMLOPT = $(CAMLRUN) $(ROOTDIR)/ocamlopt$(EXE) -nostdlib -I $(ROOTDIR)/stdlib
COMPFLAGS = -absname -w +a-4-9-41-42-44-45-48 -warn-error A \
-safe-string -strict-sequence -strict-formats -bin-annot
LINKFLAGS =
-YACCFLAGS = -v
CAMLLEX = $(CAMLRUN) $(ROOTDIR)/boot/ocamllex
CAMLDEP = $(BOOT_OCAMLC) -depend
DEPFLAGS = -slash
OBJS=cset.cmo syntax.cmo parser.cmo lexer.cmo table.cmo lexgen.cmo \
compact.cmo common.cmo output.cmo outputbis.cmo main.cmo
+programs := ocamllex ocamllex.opt
+
+$(foreach program, $(programs), $(eval $(call PROGRAM_SYNONYM,$(program))))
+
.PHONY: all allopt opt.opt # allopt and opt.opt are synonyms
all: ocamllex
allopt: ocamllex.opt
opt.opt: allopt
-ocamllex: $(OBJS)
- $(CAMLC) $(LINKFLAGS) -compat-32 -o ocamllex $(OBJS)
+ocamllex$(EXE): $(OBJS)
+ $(CAMLC) $(LINKFLAGS) -compat-32 -o $@ $^
-ocamllex.opt: $(OBJS:.cmo=.cmx)
- $(CAMLOPT_CMD) -o ocamllex.opt $(OBJS:.cmo=.cmx)
+ocamllex.opt$(EXE): $(OBJS:.cmo=.cmx)
+ $(CAMLOPT_CMD) -o $@ $^
clean::
- rm -f ocamllex ocamllex.opt
+ rm -f $(programs) $(programs:=.exe)
rm -f *.cmo *.cmi *.cmx *.cmt *.cmti *.o *.obj
parser.ml parser.mli: parser.mly
- $(CAMLYACC) $(YACCFLAGS) parser.mly
+ $(CAMLYACC) -v parser.mly
clean::
rm -f parser.ml parser.mli parser.output
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.
.IP
The default setting is
-.BR \-w\ +a\-4\-6\-7\-9\-27\-29\-30\-32..42\-44\-45\-48\-50\-60\-66 .
+.BR \-w\ +a\-4\-6\-7\-9\-27\-29\-30\-32..42\-44\-45\-48\-50\-60\-66\-67\-68 .
Note that warnings
.BR 5 \ and \ 10
are not always triggered, depending on the internals of the type checker.
Stop compilation after the given compilation pass. The currently
supported passes are:
.BR parsing ,
-.BR typing .
+.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
from the following:
.B 0x001
-Start of major GC cycle.
+Start and end of major GC cycle.
.B 0x002
Minor collection and major GC slice.
html: tools
$(MAKE) -C manual html
+web: tools
+ $(MAKE) -C manual web
+
release:
$(MAKE) -C manual release
$(MAKE) -C manual clean
$(MAKE) -C tools clean
$(MAKE) -C tests clean
+
+.PHONY: distclean
+distclean:
+ $(MAKE) -C manual distclean
- Native-code compilation (ocamlopt): `native.etex`
- Lexer and parser generators (ocamllex, ocamlyacc): `lexyacc.etex`
- Dependency generator (ocamldep): `ocamldep.etex`
- - The browser/editor (ocamlbrowser): `browser.etex`
- The documentation generator (ocamldoc): `ocamldoc.etex`
- The debugger (ocamldebug): `debugger.etex`
- Profiling (ocamlprof): `profil.etex`
- - The ocamlbuild compilation manager: `ocamlbuild.etex`
- Interfacing C with OCaml: `intf-c.etex`
- Optimisation with Flambda: `flambda.etex`
- - Memory profiling with Spacetime: `spacetime-chapter.etex`
- Fuzzing with afl-fuzz: `afl-fuzz.etex`
- Runtime tracing with the instrumented runtime: `instrumented-runtime.etex`
- The standard library: `stdlib-blurb.etex`
- The compiler front-end: `compilerlibs.etex`
- The unix library: Unix system calls: `libunix.etex`
- - The legacy num library: this library has been removed from the core
- distribution, see `libnum.etex`
- The str library: regular expressions and string processing: `libstr.etex`
- The threads library: `libthreads.etex`
- - The graphics library: `libgraph.etex`
- The dynlink library: dynamic loading and linking of object files:
`libdynlink.etex`
- - The bigarray library: `libbigarray.etex`
Latex extensions
----------------
warnings.tex
foreword.htex
manual.html
+webman
htmlman/libref/style.css: style.css $(STDLIB_MLIS) $(DOC_STDLIB_TEXT)
mkdir -p htmlman/libref
$(OCAMLDOC) -colorize-code -sort -html \
+ -charset "UTF-8" \
-d htmlman/libref \
$(DOC_STDLIB_INCLUDES) \
$(DOC_STDLIB_TEXT:%=-text %) \
$(COMPILERLIBS_MLIS)
mkdir -p htmlman/compilerlibref
$(OCAMLDOC) -colorize-code -sort -html \
+ -charset "UTF-8" \
-d htmlman/compilerlibref \
-I $(SRC)/stdlib \
$(DOC_COMPILERLIBS_INCLUDES) \
cp textman/manual.txt $(RELEASE)refman.txt
tar cf - infoman/ocaml.info* | gzip > $(RELEASE)refman.info.tar.gz
+web: html
+ $(MAKE) -C html_processing all
files: $(FILES)
$(MAKE) -C cmds all
echo "% when a new warning is documented.";\
echo "%";\
$(SET_LD_PATH) $(SRC)/boot/ocamlrun $(SRC)/ocamlc -warn-help \
- | sed -e 's/^ *\([0-9A-Z][0-9]*\)\(.*\)/\\item[\1] \2/'\
+ | 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 --inplace is not portable, emulate
for i in 52 57; do\
sed\
- s'/\\item\['$$i'\]/\\item\['$$i' (see \\ref{ss:warn'$$i'})\]/'\
+ s'/\\item\[\('$$i'[^]]*\)\]/\\item\[\1 (see \\ref{ss:warn'$$i'})\]/'\
$@ > $@.tmp;\
mv $@.tmp $@;\
done
$(MAKE) -C library clean
$(MAKE) -C refman clean
$(MAKE) -C tutorials clean
+ $(MAKE) -C html_processing clean
-rm -f texstuff/*
cd htmlman; rm -rf libref compilerlibref index.html \
manual*.html *.haux *.hind *.svg
\begin{quote}
\rule{}{}
This manual is also available in
-\ahref{https://ocaml.org/releases/\ocamlversion/ocaml-\ocamlversion-refman.pdf}{PDF}.
+\ahref{https://ocaml.org/releases/\ocamlversion/ocaml-\ocamlversion-refman.pdf}{PDF},
\ahref{https://ocaml.org/releases/\ocamlversion/ocaml-\ocamlversion-refman.txt}{plain text},
as a
\ahref{https://ocaml.org/releases/\ocamlversion/ocaml-\ocamlversion-refman-html.tar.gz}{bundle of HTML files},
\input{native.tex}
\input{lexyacc.tex}
\input{ocamldep.tex}
-\input{browser.tex}
\input{ocamldoc.tex}
\input{debugger.tex}
\input{profil.tex}
-\input{ocamlbuild.tex}
-% \input emacs.tex
\input{intf-c.tex}
\input{flambda.tex}
-\input{spacetime-chapter.tex}
\input{afl-fuzz.tex}
\input{instrumented-runtime.tex}
\input{stdlib-blurb.tex}
\input{compilerlibs.tex}
\input{libunix.tex}
-\input{libnum.tex}
\input{libstr.tex}
\input{libthreads.tex}
-\input{libgraph.tex}
\input{libdynlink.tex}
-\input{libbigarray.tex}
+\input{old.tex}
-\part{Appendix}
-\label{p:appendix}
+\part{Indexes}
+\label{p:indexes}
\ifouthtml
\begin{links}
TRANSF = $(SET_LD_PATH) $(OCAMLRUN) $(TOOLS)/transf
FILES = comp.tex top.tex runtime.tex native.tex lexyacc.tex intf-c.tex \
- ocamldep.tex profil.tex debugger.tex browser.tex ocamldoc.tex \
- warnings-help.tex ocamlbuild.tex flambda.tex spacetime-chapter.tex \
+ ocamldep.tex profil.tex debugger.tex ocamldoc.tex \
+ warnings-help.tex flambda.tex \
afl-fuzz.tex instrumented-runtime.tex unified-options.tex
-WITH_TRANSF = top.tex intf-c.tex flambda.tex spacetime-chapter.tex \
+WITH_TRANSF = top.tex intf-c.tex flambda.tex \
afl-fuzz.tex lexyacc.tex debugger.tex
WITH_CAMLEXAMPLE = instrumented-runtime.tex ocamldoc.tex
+++ /dev/null
-\chapter{The browser/editor (ocamlbrowser)} \label{c:browser}
-%HEVEA\cutname{browser.html}
-
-Since OCaml version 4.02, the OCamlBrowser tool and the Labltk library
-are distributed separately from the OCaml compiler. The project is now
-hosted at \url{https://forge.ocamlcore.org/projects/labltk/}.
\section{s:inf-debugger}{Running the debugger under Emacs}
-The most user-friendly way to use the debugger is to run it under Emacs.
-See the file "emacs/README" in the distribution for information on how
-to load the Emacs Lisp files for OCaml support.
+The most user-friendly way to use the debugger is to run it under Emacs with
+the OCaml mode available through MELPA and also at
+\url{https://github.com/ocaml/caml-mode}.
The OCaml debugger is started under Emacs by the command "M-x
camldebug", with argument the name of the executable file
\end{alltt}
This defines the value name \var{name} as a function with type
\var{type} that executes by calling the given C function.
-For instance, here is how the "int_of_string" primitive is declared in the
+For instance, here is how the "seek_in" primitive is declared in the
standard library module "Stdlib":
\begin{verbatim}
- external int_of_string : string -> int = "caml_int_of_string"
+ external seek_in : in_channel -> int -> unit = "caml_ml_seek_in"
\end{verbatim}
Primitives with several arguments are always curried. The C function
does not necessarily have the same name as the ML function.
The arity (number of arguments) of a primitive is automatically
determined from its OCaml type in the "external" declaration, by
counting the number of function arrows in the type. For instance,
-"input" above has arity 4, and the "input" C function is called with
-four arguments. Similarly,
+"seek_in" above has arity 2, and the "caml_ml_seek_in" C function
+is called with two arguments. Similarly,
\begin{verbatim}
- external input2 : in_channel * bytes * int * int -> int = "input2"
+ external seek_in_pair: in_channel * int -> unit = "caml_ml_seek_in_pair"
\end{verbatim}
-has arity 1, and the "input2" C function receives one argument (which
-is a quadruple of OCaml values).
+has arity 1, and the "caml_ml_seek_in_pair" C function receives one argument
+(which is a pair of OCaml values).
Type abbreviations are not expanded when determining the arity of a
primitive. For instance,
\entree{"caml/threads.h"}{operations for interfacing in the presence
of multiple threads (see section~\ref{s:C-multithreading}).}
\end{tableau}
-Before including any of these files, you should define the "OCAML_NAME_SPACE"
+Before including any of these files, you should define the "CAML_NAME_SPACE"
macro. For instance,
\begin{verbatim}
#define CAML_NAME_SPACE
false otherwise
\item "Is_block("\var{v}")" is true if value \var{v} is a pointer to a block,
and false if it is an immediate integer.
+\item "Is_none("\var{v}")" is true if value \var{v} is "None".
+\item "Is_some("\var{v}")" is true if value \var{v} (assumed to be of option
+type) corresponds to the "Some" constructor.
\end{itemize}
\subsection{ss:c-int-ops}{Operations on integers}
\item "Bool_val("\var{v}")" returns 0 if \var{v} is the OCaml boolean
"false", 1 if \var{v} is "true".
\item "Val_true", "Val_false" represent the OCaml booleans "true" and "false".
+\item "Val_none" represents the OCaml value "None".
\end{itemize}
\subsection{ss:c-block-access}{Accessing blocks}
\item "caml_field_unboxable("\var{v}")" calls either
"caml_field_unboxed" or "caml_field_boxed" according to the default
representation of unboxable types in the current version of OCaml.
+\item "Some_val("\var{v}")" returns the argument "\var{x}" of a value \var{v} of
+the form "Some("\var{x}")".
\end{itemize}
The expressions "Field("\var{v}", "\var{n}")",
"Byte("\var{v}", "\var{n}")" and
\item "caml_alloc_unboxable("\var{v}")" calls either
"caml_alloc_unboxed" or "caml_alloc_boxed" according to the default
representation of unboxable types in the current version of OCaml.
+\item "caml_alloc_some("\var{v}")" allocates a block representing
+"Some("\var{v}")".
\end{itemize}
\subsubsection{sss:c-low-level-alloc}{Low-level interface}
Example:
\begin{verbatim}
-value bar (value v1, value v2, value v3)
+CAMLprim value bar (value v1, value v2, value v3)
{
CAMLparam3 (v1, v2, v3);
CAMLlocal1 (result);
Example:
\begin{verbatim}
-value bar (value v1, value v2, value v3)
+CAMLprim value bar (value v1, value v2, value v3)
{
CAMLparam3 (v1, v2, v3);
CAMLlocal1 (result);
return v;
}
-value caml_curses_initscr(value unit)
+CAMLprim value caml_curses_initscr(value unit)
{
CAMLparam1 (unit);
CAMLreturn (alloc_window(initscr()));
}
-value caml_curses_endwin(value unit)
+CAMLprim value caml_curses_endwin(value unit)
{
CAMLparam1 (unit);
endwin();
CAMLreturn (Val_unit);
}
-value caml_curses_refresh(value unit)
+CAMLprim value caml_curses_refresh(value unit)
{
CAMLparam1 (unit);
refresh();
CAMLreturn (Val_unit);
}
-value caml_curses_wrefresh(value win)
+CAMLprim value caml_curses_wrefresh(value win)
{
CAMLparam1 (win);
wrefresh(Window_val(win));
CAMLreturn (Val_unit);
}
-value caml_curses_newwin(value nlines, value ncols, value x0, value y0)
+CAMLprim value caml_curses_newwin(value nlines, value ncols, value x0, value y0)
{
CAMLparam4 (nlines, ncols, x0, y0);
CAMLreturn (alloc_window(newwin(Int_val(nlines), Int_val(ncols),
Int_val(x0), Int_val(y0))));
}
-value caml_curses_addch(value c)
+CAMLprim value caml_curses_addch(value c)
{
CAMLparam1 (c);
addch(Int_val(c)); /* Characters are encoded like integers */
CAMLreturn (Val_unit);
}
-value caml_curses_mvwaddch(value win, value x, value y, value c)
+CAMLprim value caml_curses_mvwaddch(value win, value x, value y, value c)
{
CAMLparam4 (win, x, y, c);
mvwaddch(Window_val(win), Int_val(x), Int_val(y), Int_val(c));
CAMLreturn (Val_unit);
}
-value caml_curses_addstr(value s)
+CAMLprim value caml_curses_addstr(value s)
{
CAMLparam1 (s);
addstr(String_val(s));
CAMLreturn (Val_unit);
}
-value caml_curses_mvwaddstr(value win, value x, value y, value s)
+CAMLprim value caml_curses_mvwaddstr(value win, value x, value y, value s)
{
CAMLparam4 (win, x, y, s);
mvwaddstr(Window_val(win), Int_val(x), Int_val(y), String_val(s));
Example:
\begin{verbatim}
- value call_caml_f_ex(value closure, value arg)
+ CAMLprim value call_caml_f_ex(value closure, value arg)
{
CAMLparam2(closure, arg);
CAMLlocal2(res, tmp);
\entree{"CAML_BA_NATIVE_INT"}{32- or 64-bit (platform-native) integers}
\end{tableau}
%
+\paragraph{Warning:}
+"Caml_ba_array_val("\var{v}")" must always be dereferenced immediately and not stored
+anywhere, including local variables.
+It resolves to a derived pointer: it is not a valid OCaml value but points to
+a memory region managed by the GC. For this reason this value must not be
+stored in any memory location that could be live cross a GC.
+
The following example shows the passing of a two-dimensional Bigarray
to a C function and a Fortran function.
\begin{verbatim}
extern void my_c_function(double * data, int dimx, int dimy);
extern void my_fortran_function_(double * data, int * dimx, int * dimy);
- value caml_stub(value bigarray)
+ CAMLprim value caml_stub(value bigarray)
{
int dimx = Caml_ba_array_val(bigarray)->dim[0];
int dimy = Caml_ba_array_val(bigarray)->dim[1];
extern long my_c_array[100][200];
extern float my_fortran_array_[300][400];
- value caml_get_c_array(value unit)
+ CAMLprim value caml_get_c_array(value unit)
{
long dims[2];
dims[0] = 100; dims[1] = 200;
2, my_c_array, dims);
}
- value caml_get_fortran_array(value unit)
+ CAMLprim value caml_get_fortran_array(value unit)
{
return caml_ba_alloc_dims(CAML_BA_FLOAT32 | CAML_BA_FORTRAN_LAYOUT,
2, my_fortran_array_, 300L, 400L);
}
\end{verbatim}
-For convenicence, when all arguments and the result are annotated with
+For convenience, when all arguments and the result are annotated with
"[\@unboxed]", it is possible to put the attribute only once on the
declaration itself. So we can also write instead:
The output of the linking phase is a regular Unix or Windows
executable file. It does not need "ocamlrun" to run.
-% The following two paragraphs are a duplicate from the description of the batch compiler.
+The compiler is able to emit some information on its internal stages:
-The compiler is able to emit some information on its internal stages.
-It can output ".cmt" files for the implementation of the compilation unit
+\begin{itemize}
+\item
+% The following two paragraphs are a duplicate from the description of the batch compiler.
+".cmt" files for the implementation of the compilation unit
and ".cmti" for signatures if the option "-bin-annot" is passed to it (see the
description of "-bin-annot" below).
Each such file contains a typed abstract syntax tree (AST), that is produced
These ".cmt" and ".cmti" files are typically useful for code inspection tools.
+\item
+".cmir-linear" files for the implementation of the compilation unit
+if the option "-save-ir-after scheduling" is passed to it.
+Each such file contains a low-level intermediate representation,
+produced by the instruction scheduling pass.
+
+An external tool can perform low-level optimisations,
+such as code layout, by transforming a ".cmir-linear" file.
+To continue compilation, the compiler can be invoked with (a possibly modified)
+".cmir-linear" file as an argument, instead of the corresponding source file.
+\end{itemize}
+
\section{s:native-options}{Options}
The following command-line options are recognized by "ocamlopt".
% compilers and toplevel
\input{unified-options.tex}
-\paragraph{Options for the IA32 architecture}
-The IA32 code generator (Intel Pentium, AMD Athlon) supports the
+\paragraph{Options for the 32-bit x86 architecture}
+The 32-bit code generator for Intel/AMD x86 processors ("i386"
+architecture) supports the
following additional option:
\begin{options}
-\item["-ffast-math"] Use the IA32 instructions to compute
+\item["-ffast-math"] Use the processor instructions to compute
trigonometric and exponential functions, instead of calling the
corresponding library routines. The functions affected are:
"atan", "atan2", "cos", "log", "log10", "sin", "sqrt" and "tan".
$[-2^{64}, 2^{64}]$.
\end{options}
-\paragraph{Options for the AMD64 architecture}
-The AMD64 code generator (64-bit versions of Intel Pentium and AMD
-Athlon) supports the following additional options:
+\paragraph{Options for the 64-bit x86 architecture}
+The 64-bit code generator for Intel/AMD x86 processors ("amd64"
+architecture) supports the following additional options:
\begin{options}
\item["-fPIC"] Generate position-independent machine code. This is
beneficial, but produces floating-point results that differ slightly
from those produced by the bytecode interpreter.
-\item On IA32 processors only (Intel and AMD x86 processors in 32-bit
-mode), some intermediate results in floating-point computations are
+\item On Intel/AMD x86 processors in 32-bit mode,
+some intermediate results in floating-point computations are
kept in extended precision rather than being rounded to double
precision like the bytecode compiler always does. Floating-point
results can therefore differ slightly between bytecode and native code.
+++ /dev/null
-\chapter{The ocamlbuild compilation manager} \label{c:ocamlbuild}
-
-Since OCaml version 4.03, the ocamlbuild compilation manager is
-distributed separately from the OCaml compiler. The project is now
-hosted at \url{https://github.com/ocaml/ocamlbuild/}.
Process \var{file} as a ".mli" file.
\item["-map" \var{file}]
-Read an propagate the delayed dependencies for module aliases in
+Read and propagate the delayed dependencies for module aliases in
\var{file}, so that the following files will depend on the
exported aliased modules if they use them. See the example below.
(If "OCAMLRUNPARAM" is not set, "CAMLRUNPARAM" will be used instead.)
This variable must be a sequence of parameter specifications separated
by commas.
+ For convenience, commas at the beginning of the variable are ignored,
+ and multiple runs of commas are interpreted as a single one.
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;
\fi
\begin{options}
\item[b] (backtrace) Trigger the printing of a stack backtrace
- when an uncaught exception aborts the program.
- This option takes no argument.
+ when an uncaught exception aborts the program. An optional argument can
+ be provided: "b=0" turns backtrace printing off; "b=1" is equivalent to
+ "b" and turns backtrace printing on; "b=2" turns backtrace printing on
+ and forces the runtime system to load debugging information at program
+ 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[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
\item[v] ("verbose") What GC messages to print to stderr. This
is a sum of values selected from the following:
\begin{options}
- \item[1 (= 0x001)] Start of major GC cycle.
+ \item[1 (= 0x001)] Start and end of major GC cycle.
\item[2 (= 0x002)] Minor collection and major GC slice.
\item[4 (= 0x004)] Growing and shrinking of the heap.
\item[8 (= 0x008)] Resizing of stacks and memory manager tables.
+++ /dev/null
-\chapter{Memory profiling with Spacetime}
-%HEVEA\cutname{spacetime.html}
-
-\section{s:spacetime-overview}{Overview}
-
-Spacetime is the name given to functionality within the OCaml compiler that
-provides for accurate profiling of the memory behaviour of a program.
-Using Spacetime it is possible to determine the source of memory leaks
-and excess memory allocation quickly and easily. Excess allocation slows
-programs down both by imposing a higher load on the garbage collector and
-reducing the cache locality of the program's code. Spacetime provides
-full backtraces for every allocation that occurred on the OCaml heap
-during the lifetime of the program including those in C stubs.
-
-Spacetime only analyses the memory behaviour of a program with respect to
-the OCaml heap allocators and garbage collector. It does not analyse
-allocation on the C heap. Spacetime does not affect the memory behaviour
-of a program being profiled with the exception of any change caused by the
-overhead of profiling (see section\ \ref{s:spacetime-runtimeoverhead})---for example
-the program running slower might cause it to allocate less memory in total.
-
-Spacetime is currently only available for x86-64 targets and has only been
-tested on Linux systems (although it is expected to work on most modern
-Unix-like systems and provision has been made for running under
-Windows). It is expected that the set of supported platforms will
-be extended in the future.
-
-\section{s:spacetime-howto}{How to use it}
-
-\subsection{ss:spacetime-building}{Building}
-
-To use Spacetime it is necessary to use an OCaml compiler that was
-configured with the {\tt -spacetime} option. It is not possible to select
-Spacetime on a per-source-file basis or for a subset of files in a project;
-all files involved in the executable being profiled must be built with the
-Spacetime compiler. Only native code compilation is supported (not
-bytecode).
-
-If the {\tt libunwind} library is not available on the system then it will
-not be possible for Spacetime to profile allocations occurring within
-C stubs. If the {\tt libunwind} library is available but in an unusual
-location then that location may be specified to the {\tt configure} script
-using the {\tt -libunwinddir} option (or alternatively, using separate
-{\tt -libunwindinclude} and {\tt -libunwindlib} options).
-
-OPAM switches will be provided for Spacetime-configured compilers.
-
-Once the appropriate compiler has been selected the program should be
-built as normal (ensuring that all files are built with the Spacetime
-compiler---there is currently no protection to ensure this is the case, but
-it is essential). For many uses it will not be necessary to change the
-code of the program to use the profiler.
-
-Spacetime-configured compilers run slower and occupy more memory than their
-counterparts. It is hoped this will be fixed in the future as part of
-improved cross compilation support.
-
-\subsection{ss:spacetime-running}{Running}
-
-Programs built with Spacetime instrumentation have a dependency on
-the {\tt libunwind} library unless that was unavailable at configure time or
-the {\tt -disable-libunwind} option was specified
-(see section\ \ref{s:spacetime-runtimeoverhead}).
-
-Setting the {\tt OCAML\_SPACETIME\_INTERVAL} environment variable to an
-integer representing a number of milliseconds before running a program built
-with Spacetime will cause memory profiling to be in operation when the
-program is started. The contents of the OCaml heap will be sampled each
-time the number of milliseconds that the program has spent executing since the
-last sample exceeds the given number. (Note that the time base is combined
-user plus system time---{\em not} wall clock time. This peculiarity may be
-changed in future.)
-
-The program being profiled must exit normally or be caused to exit using
-the {\tt SIGINT} signal (e.g. by pressing Ctrl+C). When the program exits
-files will be written in the directory that was the working directory when
-the program was started. One Spacetime file will be written for each
-process that was involved, indexed by process ID; there will normally only
-be one such. The Spacetime files may be substantial. The directory to which
-they are written may be overridden by setting
-the {\tt OCAML\_SPACETIME\_SNAPSHOT\_DIR} environment variable before the
-program is started.
-
-Instead of using the automatic snapshot facility described above it is also
-possible to manually control Spacetime profiling. (The environment variables
-{\tt OCAML\_SPACETIME\_INTERVAL} and {\tt OCAML\_SPACETIME\_SNAPSHOT\_DIR}
-are then not relevant.) Full documentation as regards this method of profiling
-is provided in the standard library documentation (section\ \ref{c:stdlib})
-for the {\tt Spacetime} module.
-
-\subsection{ss:spacetime-analysis}{Analysis}
-
-The compiler distribution does not itself provide the facility for analysing
-Spacetime output files; this is left to external tools. The first such tool
-will appear in OPAM as a package called {\tt prof_spacetime}. That tool will
-provide interactive graphical and terminal-based visualisation of
-the results of profiling.
-
-\section{s:spacetime-runtimeoverhead}{Runtime overhead}
-
-The runtime overhead imposed by Spacetime varies considerably depending on
-the particular program being profiled. The overhead may be as low as
-ten percent---but more usually programs should be expected to run at perhaps
-a third or quarter of their normal speed. It is expected that this overhead
-will be reduced in future versions of the compiler.
-
-Execution speed of instrumented programs may be increased by using a compiler
-configured with the {\tt -disable-libunwind} option. This prevents collection
-of profiling information from C stubs.
-
-Programs running with Spacetime instrumentation consume significantly more
-memory than their non-instrumented counterparts. It is expected that this
-memory overhead will also be reduced in the future.
-
-\section{s:spacetime-dev}{For developers}
-
-The compiler distribution provides an ``{\tt otherlibs}'' library called
-{\tt raw\_spacetime\_lib} for decoding Spacetime files. This library
-provides facilities to read not only memory profiling information but also
-the full dynamic call graph of the profiled program which is written into
-Spacetime output files.
-
-A library package {\tt spacetime\_lib} will be provided in OPAM
-to provide an interface for decoding profiling information at a higher
-level than that provided by {\tt raw\_spacetime\_lib}.
\nat{%
\item["-nodynlink"]
-Allow the compiler to use some optimizations that are valid only for code
-that is never dynlinked.
+Allow the compiler to use some optimizations that are valid only for
+code that is statically linked to produce a non-relocatable
+executable. The generated code cannot be linked to produce a shared
+library nor a position-independent executable (PIE). Many operating
+systems produce PIEs by default, causing errors when linking code
+compiled with "-nodynlink". Either do not use "-nodynlink" or pass
+the option "-ccopt -no-pie" at link-time.
}%nat
\item["-nolabels"]
\notop{
\item["-stop-after" \var{pass}]
Stop compilation after the given compilation pass. The currently
-supported passes are: "parsing", "typing".
-}%notop
+supported passes are:
+"parsing", "typing"\nat{, "scheduling", "emit"}.
+}%notop
+
+\nat{
+\item["-save-ir-after" \var{pass}]
+Save intermediate representation after the given compilation pass
+to a file.
+The currently supported passes and the corresponding file extensions are:
+"scheduling" (".cmir-linear").
+
+This experimental feature enables external tools to inspect and manipulate
+compiler's intermediate representation of the program
+using "compiler-libs" library (see
+\ifouthtml chapter~\ref{c:parsinglib} and
+\ahref{compilerlibref/Compiler\_libs.html}{ \texttt{Compiler_libs} }
+\else section~\ref{Compiler-underscorelibs}\fi
+).
+}%nat
\nat{%
\item["-S"]
to \var{lowercase-letter}.
\end{options}
-Warning numbers and letters which are out of the range of warnings
-that are currently defined are ignored. The warnings are as follows.
+Alternatively, \var{warning-list} can specify a single warning using its
+mnemonic name (see below), as follows:
+
+\begin{options}
+\item["+"\var{name}] Enable warning \var{name}.
+\item["-"\var{name}] Disable warning \var{name}.
+\item["@"\var{name}] Enable and mark as fatal warning \var{name}.
+\end{options}
+
+Warning numbers, letters and names which are not currently defined are
+ignored. The warnings are as follows (the name following each number specifies
+the mnemonic for that warning).
\begin{options}
\input{warnings-help.tex}
\end{options}
\item Part~\ref{p:library}, ``The OCaml library'', describes the
modules provided in the standard library.
\begin{latexonly}
-\item Part~\ref{p:appendix}, ``Appendix'', contains an
+\item Part~\ref{p:indexes}, ``Indexes'', contains an
index of all identifiers defined in the standard library, and an
index of keywords.
\end{latexonly}
\end{unix}
\begin{windows} This is material specific to Microsoft Windows
- (XP, Vista, 7, 8, 10).
+ (Vista, 7, 8, 10).
\end{windows}
\section*{license}{License}
--- /dev/null
+dune
+markup.ml
+uchar
+uutf
+lambdasoup
+ocaml-re
+.sass-cache
--- /dev/null
+DUNE_CMD := $(if $(wildcard dune/dune.exe),dune/dune.exe,dune)
+DUNE ?= $(DUNE_CMD)
+
+DEBUG ?= 0
+ifeq ($(DEBUG), 1)
+ DBG=
+else
+ DBG=quiet
+endif
+
+WEBDIR = ../webman
+WEBDIRMAN = $(WEBDIR)/manual
+WEBDIRAPI = $(WEBDIR)/api
+WEBDIRCOMP = $(WEBDIRAPI)/compilerlibref
+
+# The "all" target generates the Web Manual in the directories
+# ../webman/manual, ../webman/api, and ../webman/api/compilerlibref
+all: css js img
+ $(DUNE) exec --root=. src/process_manual.exe $(DBG)
+ $(DUNE) exec --root=. src/process_api.exe overwrite $(DBG)
+ $(DUNE) exec --root=. src/process_api.exe compiler overwrite $(DBG)
+
+$(WEBDIR):
+ mkdir -p $(WEBDIRMAN)
+ mkdir -p $(WEBDIRCOMP)
+
+$(WEBDIRMAN)/manual.css: scss/_common.scss scss/manual.scss $(WEBDIR)
+ sass scss/manual.scss > $(WEBDIRMAN)/manual.css
+
+$(WEBDIRAPI)/style.css: scss/_common.scss scss/style.scss $(WEBDIR)
+ sass scss/style.scss > $(WEBDIRAPI)/style.css
+ cp $(WEBDIRAPI)/style.css $(WEBDIRCOMP)/style.css
+
+css: $(WEBDIRMAN)/manual.css $(WEBDIRAPI)/style.css
+
+# Just copy the JS files
+JS_FILES0 := scroll.js navigation.js
+JS_FILES1 := $(JS_FILES0) search.js
+JS_FILES := $(addprefix $(WEBDIRAPI)/, $(JS_FILES1)) $(addprefix $(WEBDIRCOMP)/, $(JS_FILES1)) $(addprefix $(WEBDIRMAN)/, $(JS_FILES0))
+
+# There must be a more clever way
+$(WEBDIRAPI)/%.js: js/%.js
+ cp $< $@
+
+$(WEBDIRMAN)/%.js: js/%.js
+ cp $< $@
+
+$(WEBDIRCOMP)/%.js: js/%.js
+ cp $< $@
+
+js: $(WEBDIR) $(JS_FILES)
+
+# download images for local use
+SEARCH := search_icon.svg
+$(WEBDIRAPI)/search_icon.svg: $(WEBDIR)
+ curl "https://ocaml.org/img/search.svg" > $(WEBDIRAPI)/$(SEARCH)
+ cp $(WEBDIRAPI)/$(SEARCH) $(WEBDIRCOMP)/$(SEARCH)
+
+LOGO := colour-logo.svg
+$(WEBDIRAPI)/colour-logo.svg: $(WEBDIR)
+ curl "https://raw.githubusercontent.com/ocaml/ocaml-logo/master/Colour/SVG/colour-logo.svg" > $(WEBDIRAPI)/$(LOGO)
+ cp $(WEBDIRAPI)/$(LOGO) $(WEBDIRMAN)/$(LOGO)
+ cp $(WEBDIRAPI)/$(LOGO) $(WEBDIRCOMP)/$(LOGO)
+
+ICON := favicon.ico
+$(WEBDIRAPI)/favicon.ico: $(WEBDIR)
+ curl "https://raw.githubusercontent.com/ocaml/ocaml-logo/master/Colour/Favicon/32x32.ico" > $(WEBDIRAPI)/$(ICON)
+ cp $(WEBDIRAPI)/$(ICON) $(WEBDIRMAN)/$(ICON)
+ cp $(WEBDIRAPI)/$(ICON) $(WEBDIRCOMP)/$(ICON)
+
+IMG_FILES0 := colour-logo.svg
+IMG_FILES := $(addprefix $(WEBDIRAPI)/, $(IMG_FILES0)) $(addprefix $(WEBDIRCOMP)/, $(IMG_FILES0)) $(addprefix $(WEBDIRMAN)/, $(IMG_FILES0))
+
+img: $(WEBDIR) $(WEBDIRAPI)/search_icon.svg $(WEBDIRAPI)/favicon.ico $(WEBDIRCOMP)/search_icon.svg $(WEBDIRCOMP)/favicon.ico $(IMG_FILES)
+
+clean:
+ rm -rf $(WEBDIR) src/.merlin _build
+
+distclean::
+ rm -rf .sass-cache
+
+# We need Dune and Lambda Soup; Markup.ml and Uutf are dependencies
+DUNE_TAG = 2.6.2
+LAMBDASOUP_TAG = 0.7.1
+MARKUP_TAG = 0.8.2
+UUTF_TAG = v1.0.2
+RE_TAG = 1.9.0
+
+# Duniverse rules - set-up dune and the dependencies in-tree for CI
+duniverse: dune/dune.exe re markup.ml uutf lambdasoup
+
+dune/dune.exe: dune
+ cd dune; ocaml bootstrap.ml
+
+GIT_CHECKOUT = git -c advice.detachedHead=false checkout
+
+dune:
+ git clone https://github.com/ocaml/dune.git -n -o upstream
+ cd dune; $(GIT_CHECKOUT) $(DUNE_TAG)
+
+distclean::
+ rm -rf dune
+
+re:
+ git clone https://github.com/ocaml/ocaml-re.git -n -o upstream
+ cd ocaml-re; $(GIT_CHECKOUT) $(RE_TAG)
+
+distclean::
+ rm -rf ocaml-re
+
+lambdasoup:
+ git clone https://github.com/aantron/lambdasoup.git -n -o upstream
+ cd lambdasoup; $(GIT_CHECKOUT) $(LAMBDASOUP_TAG)
+
+distclean::
+ rm -rf lambdasoup
+
+markup.ml:
+ git clone https://github.com/aantron/markup.ml.git -n -o upstream
+ cd markup.ml; $(GIT_CHECKOUT) $(MARKUP_TAG)
+
+distclean::
+ rm -rf markup.ml
+
+uutf:
+ git clone https://github.com/dbuenzli/uutf.git -n -o upstream
+ cd uutf; $(GIT_CHECKOUT) $(UUTF_TAG)
+ cd uutf; \
+ mv opam uutf.opam; \
+ echo '(lang dune 1.0)' > dune-project; \
+ echo '(name uutf)' >> dune-project; \
+ echo '(library (name uutf)(public_name uutf)(flags (:standard -w -3-27))(wrapped false))' > src/dune
+
+distclean::
+ rm -rf uutf
+
+.PHONY: css js img duniverse
--- /dev/null
+# HTML post-processing
+
+This directory contains material for enhancing the html of the manual
+and the API (from the `../htmlman` directory), including a quick
+search widget for the API.
+
+The process will create the `../webman` dir, and output the new html
+files (and assets) in `../webman/manual` (the manual) and `../webman/api` (the
+API).
+
+## manual and api
+
+There are two different scripts, `process_manual.ml` and
+`process_api.ml`. The first one deals with all the chapters of the
+manual, while the latter deals with the api generated with `ocamldoc`.
+They both use a common module `common.ml`.
+
+## How to build
+
+With dependencies to build the whole manual:
+```
+cd ..
+make web
+```
+
+Or, much faster if you know that `htmlman` is already up-to-date, from
+within the `html_processing` dir:
+
+```
+make
+```
+
+You need a working
+[`sass`](https://sass-lang.com/) CSS processor (tested with version
+"3.4.23").
+
+## How to browse
+
+From the `html_processing` directory:
+
+`firefox ../webman/api/index.html`
+
+`firefox ../webman/manual/index.html`
+
+## Debug
+
+```
+make DEBUG=1
+```
+
+By default all html files are re-created by `make`, but the javascript
+index `webman/api/index.js` and `webman/api/compilerlibref/index.js`
+are kept if they already exist. You can use `make clean` to delete all
+generated files.
+
+The javascript files in the `html_processing/js` dir add functionality
+but the web-manual is still browsable without them:
+
+- `scroll.js`: adds smooth scrolling in the html page, but only for
+ near targets. The reason is that when you jump to another place in a
+ text, if the jump is immediate (no scrolling), you easily get lost;
+ for instance you usually don't even realize that the target of the
+ link is just half a page below! Thus smooth scrolling helps
+ _understanding the structure_ of the document. However, when the
+ target is very far, the browser will scroll a huge amount of text
+ very quickly, and this becomes useless, and even painful for the
+ eye. Hence we disable smooth scrolling for far targets.
+
+- `search.js`: adds an 'as-you-type quick search widget', which
+ recognize values, modules, and type signatures. It is very useful,
+ but of course not strictly necessary.
--- /dev/null
+(lang dune 1.11)
--- /dev/null
+// NaVigation helpers for the manual, especially in mobile mode.
+
+// copyright 2020 San Vu Ngoc
+//
+
+// Permission to use, copy, modify, and/or distribute this software
+// for any purpose with or without fee is hereby granted, provided
+// that the above copyright notice and this permission notice appear
+// in all copies.
+
+// THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
+// WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
+// WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
+// AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
+// CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
+// OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
+// NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
+// CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+// In mobile mode, both left navigation bar and top part menu are
+// closed by default.
+
+var MENU_HEIGHT = 0;
+
+function closeSidebarExceptSearch (event) {
+ if ( event && event.target && event.target.classList.contains("api_search") ) {
+ false;
+ } else {
+ closeSidebar ();
+ true;
+ }
+}
+
+// This closes the sidebar in mobile mode. This should have no effect
+// in desktop mode.
+function closeSidebar () {
+ let bar = document.getElementById("sidebar");
+ let w = getComputedStyle(bar).width;
+ bar.style.left = "-" + w;
+ document.body.removeEventListener("click", closeSidebarExceptSearch);
+}
+
+function toggleSidebar () {
+ let bar = document.getElementById("sidebar");
+ let l = getComputedStyle(bar).left;
+ if (l == "0px") {
+ closeSidebar ();
+ } else {
+ bar.style.left = "0px";
+ setTimeout(function(){
+ // Any click anywhere but in search widget will close the sidebar
+ document.body.addEventListener("click", closeSidebarExceptSearch);
+ }, 1000);
+ }
+}
+
+function togglePartMenu () {
+ let pm = document.getElementById("part-menu");
+ let h = pm.offsetHeight;
+ if ( h == 0 ) {
+ pm.style.height = MENU_HEIGHT.toString() + "px";
+ } else {
+ pm.style.height = "0px";
+ }
+}
+
+function partMenu () {
+ let pm = document.getElementById("part-menu");
+ if ( pm != null ) {
+ MENU_HEIGHT = pm.scrollHeight; // This should give the true
+ // height of the menu, even if
+ // it was initialized to 0 in
+ // the CSS (mobile view).
+ // In desktop mode, the height is initially on "auto"; we
+ // have to detect it in
+ // order for the css animmations to work.
+ // TODO update this when window is resized
+ let currentHeight = pm.offsetHeight;
+ pm.style.height = currentHeight.toString() + "px";
+ let p = document.getElementById("part-title");
+ if ( p != null ) {
+ p.onclick = togglePartMenu;
+ }
+ }
+}
+
+function sideBar () {
+ closeSidebar();
+ let btn = document.getElementById("sidebar-button");
+ btn.onclick = toggleSidebar;
+}
+
+// We add it to the chain of window.onload
+window.onload=(function(previousLoad){
+ return function (){
+ previousLoad && previousLoad ();
+ partMenu ();
+ sideBar ();
+ }
+})(window.onload);
+
+
--- /dev/null
+// Smooth scrolling only for near targets
+// copyright 2019-2020 San Vu Ngoc
+//
+
+// Permission to use, copy, modify, and/or distribute this software
+// for any purpose with or without fee is hereby granted, provided
+// that the above copyright notice and this permission notice appear
+// in all copies.
+
+// THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
+// WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
+// WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
+// AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
+// CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
+// OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
+// NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
+// CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+
+// Goal: if a link is located at distance larger than MAX_DISTANCE, we
+// don't use a smooth scrolling.
+//
+// usage: to activate this, run setSmooth within window.onload:
+// window.onload = setSmooth
+// Here instead we create a loading chain because we have other things
+// to add window.onload later.
+
+const MAX_DISTANCE = 1000;
+const SCROLL_DURATION = 600;
+
+const url = window.location.pathname;
+var filename = url.substring(url.lastIndexOf('/')+1);
+if (filename == "") { filename = "index.html"; }
+
+function localLink (link) {
+ return (link.length > 0 &&
+ (link.charAt(0) == '#'
+ || link.substring(0,filename.length) == filename));
+}
+
+//aaa.html#s%3Adatatypes --> s:datatypes
+function getId (link) {
+ let uri = link.substring(link.lastIndexOf('#')+1);
+ return decodeURIComponent(uri)
+ // for instance decodeURIComponent("s%3Adatatypes") == 's:datatypes'
+}
+
+// Get absolute y position of element.
+// modified from:
+// https://www.kirupa.com/html5/get_element_position_using_javascript.htm
+// assuming effective licence CC0, see
+// https://forum.kirupa.com/t/get-an-elements-position-using-javascript/352186/3
+function getPosition(el) {
+ let yPos = 0;
+ while (el) {
+ yPos += (el.offsetTop + el.clientTop);
+ el = el.offsetParent;
+ }
+ return yPos;
+}
+
+// This function scans all "a" tags with a valid "href", and for those
+// that are local links (links within the same file) it adds a special
+// onclick function for smooth scrolling.
+function setSmooth () {
+ let a = document.getElementsByTagName("a");
+ let container = document.body.parentNode;
+ let i;
+ for (i = 0; i < a.length; i++) {
+ let href = a[i].getAttribute("href");
+ if (href != null && localLink(href)) {
+ a[i].onclick = function () {
+ let id = getId(href);
+ let target = "";
+ if ( id == "" ) {
+ target = container;
+ } else {
+ target = document.getElementById(id); }
+ if (! target) {
+ console.log ("Error, no target for id=" + id);
+ target = container; }
+ let top = container.scrollTop;
+ let dist = top - getPosition(target)
+ if (Math.abs(dist) < MAX_DISTANCE) {
+ target.scrollIntoView({ block: "start", inline: "nearest", behavior: 'smooth' });
+ setTimeout(function () {
+ location.href = href;
+ // this will set the "target" property.
+ }, SCROLL_DURATION);
+ return false;
+ // so we don't follow the link immediately
+ }
+ }
+ }
+ }
+}
+
+// We add it to the chain of window.onload
+window.onload=(function(previousLoad){
+ return function (){
+ previousLoad && previousLoad ();
+ setSmooth ();
+ }
+})(window.onload);
--- /dev/null
+// Searching the OCAML API.
+// Copyright 2019-2020 San VU NGOC
+
+// Permission to use, copy, modify, and/or distribute this software
+// for any purpose with or without fee is hereby granted, provided
+// that the above copyright notice and this permission notice appear
+// in all copies.
+
+// THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
+// WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
+// WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
+// AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
+// CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
+// OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
+// NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
+// CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+// Thanks @steinuil for help on deferred loading.
+// Thanks @osener, @UnixJunkie, @Armael for very helpful suggestions
+// Thanks to all testers!
+
+const MAX_RESULTS = 20;
+const MAX_ERROR = 10;
+const DESCR_INDEX = 4; // index of HTML description in index.js
+const SIG_INDEX = 6; // index of HTML signature in index.js
+const ERR_INDEX = 8; // length of each line in index.js. This is used
+ // for storing the computed error, except if we
+ // don't want description and type signature,
+ // then ERR_INDEX becomes DESCR_INDEX.
+
+let indexState = 'NOT_LOADED';
+
+// return true if we are loading the index file
+function loadingIndex (includeDescr) {
+ switch (indexState) {
+ case 'NOT_LOADED':
+ indexState = 'LOADING';
+
+ const script = document.createElement('script');
+ script.src = 'index.js';
+ script.addEventListener('load', () => {
+ indexState = 'HAS_LOADED';
+ mySearch(includeDescr);
+ });
+ document.head.appendChild(script);
+ return true;
+
+ case 'LOADING':
+ return true;
+
+ case 'HAS_LOADED':
+ return false;
+ }
+}
+
+// line is a string array. We check if sub is a substring of one of
+// the elements of the array. The start/end of the string s are marked
+// by "^" and "$", and hence these chars can be used in sub to refine
+// the search. Case sensitive is better for OCaml modules. Searching
+// within line.join() is slightly more efficient that iterating 'line'
+// with .findIndex (my benchmarks show about 15% faster; except if we
+// search for the value at the beginning of line). However it might
+// use more memory.
+function hasSubString (sub, line) {
+ let lineAll = "^" + line.join("$^") + "$";
+ return (lineAll.includes(sub));
+}
+
+// Check if one of the strings in subs is a substring of one of the
+// strings in line.
+function hasSubStrings (subs, line) {
+ let lineAll = "^" + line.join("$^") + "$";
+ return (subs.findIndex(function (sub) {
+ return (lineAll.includes(sub))}) !== -1);
+}
+// Error of sub being a substring of s. Best if starts at 0. Except
+// for strings containing "->", which is then best if the substring is
+// at the most right-hand position (representing the "return type").
+// markers "^" and "$" for start/end of string can be used: if they
+// are not satisfied, the MAX_ERROR is returned.
+function subError (sub, s) {
+ let StartOnly = false;
+ let EndOnly = false;
+ if (sub.length>1) {
+ if (sub[0] == "^") {
+ StartOnly = true;
+ sub = sub.substring(1);
+ }
+ if (sub[sub.length - 1] == "$") {
+ EndOnly = true;
+ sub = sub.substring(0, sub.length - 1);
+ }
+ }
+ let err = s.indexOf(sub);
+ if (err == -1 ||
+ (StartOnly && err != 0) ||
+ (EndOnly && err != s.length - sub.length)) {
+ err = MAX_ERROR;
+ } else {
+ if ( sub.includes("->") ) {
+ err = Math.min(s.length - sub.length - err,1); // 0 or 1
+ // err = 0 if the substring is right-aligned
+ } else {
+ err = Math.min(err,1); // 0 or 1
+ // err = 0 if the substring
+ }
+ err += Math.abs((s.length - sub.length) / s.length);}
+ return (err)
+ // between 0 and 2, except if MAX_ERROR
+}
+
+// Minimal substring error. In particular, it returns 0 if the string
+// 'sub' has an exact match with one of the strings in 'line'.
+function subMinError (sub, line) {
+ let errs = line.map(function (s) { return subError (sub, s); });
+ return Math.min(...errs); // destructuring assignment
+}
+
+
+function add (acc, a) {
+ return acc + a;
+}
+
+// for each sub we compute the minimal error within 'line', and then
+// take the average over all 'subs'. Thus it returns 0 if each sub has
+// an exact match with one of the strings in 'line'.
+function subsAvgMinError (subs, line) {
+ let errs = subs.map(function (sub) { return subMinError (sub, line); });
+ return errs.reduce(add,0) / subs.length;
+}
+
+function formatLine (line) {
+ let li = '<li>';
+ let html = `<code class="code"><a href="${line[1]}"><span class="constructor">${line[0]}</span></a>.<a href="${line[3]}">${line[2]}</a></code>`;
+ if (line.length > 5) {
+ if ( line[ERR_INDEX] == 0 ) {
+ li = '<li class="match">';
+ }
+ html = `<pre>${html} : ${line[SIG_INDEX]}</pre>${line[DESCR_INDEX]}`; }
+ return (li + html + "</li>\n");
+}
+
+// Split a string into an array of non-empty words, or phrases
+// delimited by quotes ("")
+function splitWords (s) {
+ let phrases = s.split('"');
+ let words = [];
+ phrases.forEach(function (phrase,i) {
+ if ( i%2 == 0 ) {
+ words.push(...phrase.split(" "));
+ } else {
+ words.push(phrase);
+ }
+ });
+ return (words.filter(function (s) {
+ return (s !== "")}));
+}
+
+// The initial format of an entry of the GENERAL_INDEX array is
+// [ module, module_link,
+// value, value_link,
+// html_description, bare_description,
+// html_signature, bare_signature ]
+
+// If includeDescr is false, the line is truncated to its first 4
+// elements. When searching, the search error is added at the end of
+// each line.
+
+// In order to reduce the size of the index.js file, one could create
+// the bare_description on-the-fly using .textContent, see
+// https://stackoverflow.com/questions/28899298/extract-the-text-out-of-html-string-using-javascript,
+// but it would probably make searching slower (haven't tested).
+function mySearch (includeDescr) {
+ if (loadingIndex (includeDescr)) {
+ return;
+ }
+ let text = document.getElementById('api_search').value;
+ let results = [];
+ let html = "";
+ let count = 0;
+ let err_index = DESCR_INDEX;
+
+ if (text !== "") {
+ if ( includeDescr ) {
+ err_index = ERR_INDEX;
+ }
+
+ let t0 = performance.now();
+ let exactMatches = 0;
+ results = GENERAL_INDEX.filter(function (line) {
+ // We remove the html hrefs and add the Module.value complete name:
+ let cleanLine = [line[0], line[2], line[0] + '.' + line[2]];
+ line.length = err_index; // This truncates the line:
+ // this removes the description part if includeDescr =
+ // false (which modifies the lines of the GENERAL_INDEX.)
+ if ( includeDescr ) {
+ cleanLine.push(line[DESCR_INDEX+1]);
+ cleanLine.push(line[SIG_INDEX+1]);
+ // add the description and signature (txt format)
+ }
+ let error = MAX_ERROR;
+ if ( exactMatches <= MAX_RESULTS ) {
+ // We may stop searching when exactMatches >
+ // MAX_RESULTS because the ranking between all exact
+ // matches is unspecified (depends on the construction
+ // of the GENERAL_INDEX array)
+ if ( hasSubString(text, cleanLine) ) {
+ error = subMinError(text, cleanLine);
+ // one could merge hasSubString and subMinError
+ // for efficiency
+ }
+ if ( error != 0 && includeDescr ) {
+ let words = splitWords(text);
+ if ( hasSubStrings(words, cleanLine) ) {
+ // if there is no exact match for text and
+ // includeDescr=true, we also search for all separated
+ // words
+ error = subsAvgMinError(words, cleanLine);
+ }
+ }
+ if ( error == 0 ) { exactMatches += 1; }
+ }
+ line[err_index] = error;
+ // we add the error as element #err_index
+ return ( error != MAX_ERROR );
+ });
+ // We sort the results by relevance:
+ results.sort(function(line1, line2) {
+ return (line1[err_index] - line2[err_index])});
+ count = results.length;
+ console.log("Search results = " + (count.toString()));
+ results.length = Math.min(results.length, MAX_RESULTS);
+ html = "no results";
+ }
+ // inject new html
+ if (results.length > 0) {
+ html = "<ul>";
+ function myIter(line, index, array) {
+ html = html + formatLine(line);
+ }
+ results.forEach(myIter);
+ html += "</ul>";
+ if (count > results.length) {
+ html += "(...)";
+ }
+ }
+ document.getElementById("search_results").innerHTML = html;
+}
--- /dev/null
+// SCSS Module for manual.scss and style.scss
+
+// set this to true for integration into the ocaml.org wesite
+$ocamlorg:false;
+/* ocaml logo color */
+$logocolor:#ec6a0d;
+$logo_height:67px;
+
+@if $ocamlorg {
+ .container {
+ margin-left:0;
+ margin-right:0;
+ }
+}
+
+
+/* Fonts */
+@import url(https://fonts.googleapis.com/css?family=Fira+Mono:400,500);
+@import url(https://fonts.googleapis.com/css?family=Noticia+Text:400,400i,700);
+@import url(https://fonts.googleapis.com/css?family=Fira+Sans:400,400i,500,500i,600,600i,700,700i);
+
+/* Reset */
+.pre,a,b,body,code,div,em,form,h1,h2,h3,h4,h5,h6,header,html,i,img,li,mark,menu,nav,object,output,p,pre,s,section,span,time,ul,td,var{
+ margin:0;
+ padding:0;
+ border:0;
+ font-size:inherit;
+ font:inherit;
+ line-height:inherit;
+ vertical-align:baseline;
+ text-align:inherit;
+ color:inherit;
+ background:0 0
+}
+*,:after,:before{
+ box-sizing:border-box
+}
+
+html.smooth-scroll {
+ scroll-behavior:smooth;
+}
+
+@media (prefers-reduced-motion: reduce) {
+ html {
+ scroll-behavior:auto;
+ }
+}
+
+body{
+ font-family:"Fira Sans",Helvetica,Arial,sans-serif;
+ text-align:left;
+ color:#333;
+ background:#fff
+}
+
+html {
+ font-size: 16px;
+ .dt-thefootnotes{
+ height:1ex;
+ }
+ .footnotetext{
+ font-size: 13px;
+ }
+}
+
+#sidebar-button{
+ float:right;
+ cursor: context-menu;
+ span{
+ font-size:28px;
+ }
+ display:none;
+ }
+
+.content, .api {
+ &>header {
+ margin-bottom: 30px;
+ nav {
+ font-family: "Fira Sans", Helvetica, Arial, sans-serif;
+ }
+ }
+}
+
+@mixin content-frame {
+ max-width:90ex;
+ margin-left:calc(10vw + 20ex);
+ margin-right:4ex;
+ margin-top:20px;
+ margin-bottom:50px;
+ font-family:"Noticia Text",Georgia,serif;
+ line-height:1.5
+}
+
+/* Menu in the left bar */
+@mixin nav-toc {
+ display: block;
+ padding-top: 10px;
+ position:fixed;
+ @if $ocamlorg {
+ top:0;
+ } @else {
+ top:$logo_height;
+ }
+ bottom:0;
+ left:0;
+ max-width:30ex;
+ min-width:26ex;
+ width:20%;
+ background:linear-gradient(to left,#ccc,transparent);
+ overflow:auto;
+ color:#1F2D3D;
+ padding-left:2ex;
+ padding-right:2ex;
+ .toc_version {
+ font-size:smaller;
+ text-align:right;
+ a {
+ color:#888;
+ }
+ }
+ ul{
+ list-style-type:none;
+ li{
+ margin:0;
+ ul{
+ margin:0
+ }
+ li{
+ border-left:1px solid #ccc;
+ margin-left:5px;
+ padding-left:12px;
+ }
+ a {
+ font-family:"Fira Sans",sans-serif;
+ font-size:.95em;
+ color:#333;
+ font-weight:400;
+ line-height:1.6em;
+ display:block;
+ &:hover {
+ box-shadow:none;
+ background-color: #edbf84;}
+ }
+ &.top a {
+ color: #848484;
+ &:hover {
+ background-color: unset;
+ text-decoration: underline;
+ }
+ }
+ }
+ }
+ &>ul>li {
+ margin-bottom:.3em;
+ &>a { /* First level titles */
+ font-weight:500;}
+ }
+}
+
+/* OCaml Logo */
+@mixin brand {
+ @if $ocamlorg {
+ display:none;
+ }
+ top:0;
+ height:$logo_height;
+ img{
+ margin-top:14px;
+ height:36px
+ }
+}
+
+@mixin mobile {
+ .api, .content{
+ margin:auto;
+ padding:2em;
+ h1 {
+ margin-top:0;
+ }
+ }
+}
+
+@mixin nav-toc-mobile {
+ position:static;
+ width:auto;
+ min-width:unset;
+ border:none;
+ padding:.2em 1em;
+ border-radius:5px 0;
+ &.brand {border-radius: 0 5px;}
+}
+
+/* Header is used as a side-bar */
+@mixin header-mobile {
+ margin-bottom:0;
+ position:fixed;
+ left:-10000px; /* initially hidden */
+ background-color:#ffefe7;
+ transition:left 0.4s;
+ top:0;
+ max-width:calc(100% - 2em);
+ max-height: 100%;
+ overflow-y: auto;
+ box-shadow:0.4rem 0rem 0.8rem #bbb;
+}
+
+@mixin sidebar-button {
+ #sidebar-button{
+ display:inline-block;
+ position:fixed;
+ top:1.5em;
+ right:1ex;
+ }
+}
+
+/* Print adjustements. */
+/* This page can be nicely printed or saved to PDF (local version) */
+
+@media print {
+ body {
+ color: black;
+ background: white;
+ }
+ body nav:first-child {
+ position: absolute;
+ background: transparent;
+ }
+ .content, .api {
+ nav.toc {
+ margin-right: 1em;
+ float: left;
+ position: initial;
+ background: #eee;
+ }
+ margin-left: 3em;
+ margin-right: 3em;
+ }
+}
+
+@mixin caret {
+ content:"▶";
+ color:$logocolor;
+ font-size:smaller;
+ margin-right:4px;
+ margin-left:-1em
+}
--- /dev/null
+// SOURCE FILE
+
+/* If the above line does not say "SOURCE FILE", then do not edit. It */
+/* means this file is generated from [sass manual.scss] */
+
+/* CSS file for the Ocaml manual */
+
+/* San Vu Ngoc, 2019-2020 */
+
+@import "common";
+@charset "UTF-8";
+
+.content{
+ @include content-frame;
+ #part-title{
+ float:left;
+ color:#777;
+ cursor: context-menu;
+ font-family:"Fira Sans",Helvetica,Arial,sans-serif;
+ span{ /* menu icon */
+ font-size:22px;
+ margin-right:1ex;
+ }
+ }
+ ul{list-style:none;}
+ ul.itemize li::before{@include caret;}
+
+ /* When the TOC is repeated in the main content */
+ ul.ul-content {
+ }
+ /* navigation links at the bottom of page */
+ .bottom-navigation {
+ margin-bottom:1em;
+ a.next {
+ float: right;
+ }
+ }
+ .copyright{
+ font-size:smaller;
+ display:inline-block;
+ }
+}
+.index{ /* index.html */
+ ul{
+ list-style: none;
+ li {
+ margin-left: 0.5ex;
+ span {
+ color:#c88b5f;
+ }
+ span.c003{
+ color:#564233;
+ }
+ }
+ }
+ /* only for Contents/Foreword in index.html: */
+ ul.ul-content li::before{@include caret;}
+ /* table of contents: (manual.001.html): */
+ ul.toc ul.toc ul.toc{
+ font-size:smaller;
+ }
+ section>ul>li>a{ /* for Parts title */
+ font-family:"Fira Sans",Helvetica,Arial,sans-serif;
+ font-size:larger;
+ background:linear-gradient(to left,#fff 0,#ede8e5 100%);
+ }
+ section>ul>li>ul>li:hover{ /* Chapters */
+ background:linear-gradient(to left,#fff 0,#ede8e5 100%);
+ }
+ section>ul>li>ul>li{
+ transition: background 0.5s;
+ }
+}
+b{
+ font-weight:500
+}
+em,i{
+ font-style:italic
+}
+.ocaml {
+ background:#f7f5f4;
+}
+.ocaml,pre{
+ margin-top:.8em;
+ margin-bottom:1.2em
+}
+.ocaml .pre{
+ white-space:pre
+}
+p,ul{
+ margin-top:.5em;
+ margin-bottom:1em
+}
+ul{
+ list-style-position:outside
+}
+ul>li{
+ margin-left:22px
+}
+li>:first-child{
+ margin-top:0
+}
+.left{
+ text-align:left
+}
+.right{
+ text-align:right
+}
+a{
+ text-decoration:none;
+ color:#92370a
+}
+a:hover{
+ box-shadow:0 1px 0 0 #92370a
+}
+:target{
+ background-color:rgba(255,215,181,.3)!important;
+ box-shadow:0 0 0 1px rgba(255,215,181,.8)!important;
+ border-radius:1px
+}
+:hover>a.section-anchor{
+ visibility:visible
+}
+a.section-anchor:before{
+ content:"#"
+}
+a.section-anchor:hover{
+ box-shadow:none;
+ text-decoration:none;
+ color:#555
+}
+a.section-anchor{
+ visibility:hidden;
+ position:absolute;
+ margin-left:-1.3em;
+ font-weight:400;
+ font-style:normal;
+ padding-right:.4em;
+ padding-left:.4em;
+ color:#d5d5d5
+}
+.h10,.h7,.h8,.h9,h1,h2,h3,h4,h5,h6{
+ font-family:"Fira Sans",Helvetica,Arial,sans-serif;
+ font-weight:400;
+ margin:.5em 0 .5em 0;
+ padding-top:.1em;
+ line-height:1.2;
+ overflow-wrap:break-word
+}
+h1{
+ font-weight:500;
+ font-size:2.441em;
+ margin-top:1.214em
+}
+h1{
+ font-weight:500;
+ font-size:1.953em;
+ box-shadow:0 1px 0 0 #ddd
+}
+h2{
+ font-size:1.563em
+}
+h3{
+ font-size:1.25em
+}
+h1 code{
+ font-size:inherit;
+ font-weight:inherit
+}
+h2 code{
+ font-size:inherit;
+ font-weight:inherit
+}
+h3 code{
+ font-size:inherit;
+ font-weight:inherit
+}
+h3 code{
+ font-size:inherit;
+ font-weight:inherit
+}
+h4{
+ font-size:1.12em
+}
+.ocaml,.pre,code,pre,tt{
+ font-family:"Fira Mono",courier;
+ font-weight:400
+}
+.pre,pre{
+ border-left:4px solid #e69c7f;
+ overflow-x:auto;
+ padding-left:1ex
+}
+.ocaml .pre{
+ overflow-x:initial;
+}
+.caml-example .ocaml{
+ overflow-x:auto;
+}
+li code,p code{
+ background-color:#f6f8fa;
+ color:#0d2b3e;
+ border-radius:3px;
+ padding:0 .3ex
+}
+.pre .code,.pre.code,pre code{
+ background-color:inherit
+}
+p a>code{
+ color:#92370a}
+.pre code.ocaml,.pre.code.ocaml,pre code.ocaml{
+ font-size:.893rem}
+.keyword,.ocamlkeyword{
+ font-weight:500}
+section+section{
+ margin-top:25px}
+
+/* Table of Contents in the Left-hand sidebar */
+nav.toc{
+ @include nav-toc;
+ &.brand{
+ @include brand;
+ }
+ .toc_title{
+ display:block;
+ margin:.5em 0 1.414em}
+/* .toc_title a{ */
+/* color:#777; */
+/* font-size:1em; */
+/* line-height:1.2; */
+ /* font-weight:500} */
+
+}
+.tableau {
+ table {
+ border-collapse: collapse;
+ }
+ td {
+ background:#f8f7f6;
+ border:1px solid #ccc;
+ padding-left:3px;
+ padding-right:3px;
+ }
+}
+
+pre{
+ background:linear-gradient(to left,#fff 0,#ede8e5 100%)
+}
+code.caml-output.ok,div.caml-output.ok{
+ color:#045804
+}
+code.caml-output.error,div.caml-output.error{
+ color:#ff4500;
+ white-space:normal
+}
+.chapter span,.tutorial span,.maintitle h1 span{
+ color:$logocolor
+}
+h1 span{
+ color: #d28853;
+}
+blockquote.quote{
+ margin:0;
+ /*font-size: smaller;*/
+ hr{
+ display:none;
+ }
+}
+#part-menu{
+ font-family:"Fira Sans";
+ text-align:right;
+ list-style:none;
+ overflow-y:hidden;
+ transition:height 0.3s;
+}
+#part-menu li.active a{
+ color:#000;
+ &::before{@include caret;}
+}
+span.c003{
+ color:#564233;
+ font-family:"Fira Mono",courier;
+ background-color:#f3ece6;
+ border-radius:6px
+}
+div.caml-example.toplevel code.caml-input::before,
+div.caml-example.toplevel div.caml-input::before{
+ content:"#";
+ color:#888
+}
+span.c004{
+ color:#888
+}
+span.c006{
+ font-weight:700;
+ color:#564233;
+ font-family:"Fira Mono",courier;
+}
+span.c009{
+ font-style:italic;
+ background-color:#f3ece6;
+ border-radius:6px
+}
+span.authors.c009{
+ background-color:inherit
+}
+span.c013{
+ font-weight:700
+}
+.caml-input{
+ span.ocamlkeyword{
+ font-weight:500;
+ color:#444
+ }
+ span.ocamlhighlight{
+ font-weight:500;
+ text-decoration:underline
+ }
+ span.id{
+ color:#523b74
+ }
+ span.ocamlstring,.caml-input span.string{
+ color:#df5000
+ }
+ span.comment, .caml-input span.ocamlcomment{
+ color:#969896
+ }
+}
+.ocaml span.ocamlerror{
+ font-weight:500
+}
+
+
+/* Mobile */
+@media only screen and (max-width:95ex){
+ @include mobile;
+ @include sidebar-button;
+ .content #part-menu{
+ display:inline-block;
+ height:0;
+ width:100%;
+ }
+ nav.toc{
+ @include nav-toc-mobile;
+ }
+ header{
+ @include header-mobile;
+ }
+}
--- /dev/null
+// SOURCE FILE
+
+/* If the above line does not say "SOURCE FILE", then do not edit. It */
+/* means this file is generated from [sass style.scss] */
+
+/* CSS file for the Ocaml API. San Vu Ngoc 2019 */
+
+// TODO: the ocamldoc output of Functors like in
+// compilerlibref/4.08/Arg_helper.Make.html
+// is not easy to style... without breaking other tables.
+
+@import "common";
+@charset "UTF-8";
+
+// tables are difficult to style, be careful.
+// These settings should apply to the main index tables
+// (like "index_values.html"), which do not have any particular class.
+// These tables have two columns.
+.api>table {
+ word-break: break-word;
+ // this is unfortunately due to some very long names in Internal modules
+ td.module,
+ td:first-child {
+ width: 33%;
+ }
+ td:nth-child(2) {
+ width: 65%;
+ }
+ td[align="left"] {
+ // for the "Parameter" column of module signatures like
+ // Arg_helper.Make.html, which unfortunately have no class
+ // either.
+ word-break: normal;
+ }
+ td[align="left"]:first-child {
+ width: 1%;
+ }
+}
+
+.api {
+ // font-size: 16px;
+ // font-family: "Fira Sans", Helvetica, Arial, sans-serif;
+ // text-align: left;
+ // color: #333;
+ // background: #FFFFFF;
+ table {
+ // tables are difficult to style, be careful
+ border-collapse: collapse;
+ border-spacing: 0;
+ thead {
+ background: rgb(228, 217, 211);
+ }
+ /* must be same as <pre>: */
+ background: linear-gradient(to left, white 0%, rgb(237, 232, 229) 100%);
+ width: 100%;
+ td {
+ padding-left: 1ex;
+ padding-right: 1ex;
+ /*float: left;*/
+ }
+ /* add some room at the end of the table */
+ tr:last-child td {
+ padding-bottom: 7px;
+ }
+ }
+ // Tables are used for describing types, in particular union types:
+ table.typetable {
+ width: 100%;
+ word-break: normal;
+ box-shadow: none;
+ td {
+ float: left;
+ }
+ td:nth-child(2) {
+ width: 37%;
+ code {
+ white-space: pre-line;
+ }
+ }
+ td:last-child {
+ width: calc(100% - 1.3em);
+ // cf: CamlinternalFormatBasics.html
+ // the 1.3em is related to the 1em below
+ }
+ td:first-child {
+ width: 1em;
+ }
+ td:nth-child(4).typefieldcomment {
+ /* this should be the column with the type */
+ width: 60%;
+ /* not optimal, see: Format.html#symbolic
+ but leaving it automatic is not always good either: see: Arg.html */
+ }
+ }
+
+ // for functor signature
+ table.paramstable {
+ word-break: normal;
+ td {
+ code {
+ white-space: pre-wrap;
+ }
+ }
+ td:first-child, td:nth-child(2) {
+ width: 1em; // second column should contain only
+ // ":". First one will adapt to size.
+ }
+ }
+
+ .sig_block {
+ border-left: 4px solid #e69c7f;
+ padding-left: 1em;
+ background: linear-gradient(to left, white 0%, rgb(237, 232, 229) 100%);
+ // PROBLEM the sig_block ends too soon, it should actually
+ // include the "end)" line ==> REPORT THIS
+ // (eg: compilerlibref/Arg_helper.html)
+ pre {
+ margin-top: 0;
+ background: none;
+ border-left: 0;
+ }
+ }
+ pre .sig_block {
+ margin-bottom: 0; // see above
+ border-left: 0;
+ }
+
+ *, *:before, *:after {
+ box-sizing: border-box;
+ }
+
+ @include content-frame;
+
+ /* Basic markup elements */
+
+ b, strong {
+ font-weight: 600;
+ }
+ i, em {
+ font-style: italic;
+ }
+ sup {
+ vertical-align: super;
+ }
+ sub {
+ vertical-align: sub;
+ }
+ sup, sub {
+ font-size: 12px;
+ line-height: 0;
+ margin-left: 0.2ex;
+ }
+ pre {
+ margin-top: 0.8em;
+ margin-bottom: 0;
+ }
+ p, ul, ol {
+ margin-top: 0.5em;
+ margin-bottom: 1em;
+ }
+ ul, ol {
+ list-style-position: outside
+ }
+ ul>li {
+ margin-left: 22px;
+ }
+ ol>li {
+ margin-left: 27.2px;
+ }
+ li>*:first-child {
+ margin-top: 0
+ }
+
+ /* Text alignements, this should be forbidden. */
+
+ .left {
+ text-align: left;
+ }
+ .right {
+ text-align: right;
+ }
+ .center {
+ text-align: center;
+ }
+ /* Links and anchors */
+ a {
+ text-decoration: none;
+ color: #92370A;
+ /* box-shadow: 0 1px 0 0 #d8b68b; */
+ }
+ a:hover {
+ box-shadow: 0 1px 0 0 #92370A;
+ }
+ td a:hover {
+ background: white;
+ }
+ /* Linked highlight */
+ *:target {
+ /*box-shadow: 0 0px 0 1px rgba(255, 215, 181, 0.8) !important;*/
+ border-radius: 1px;
+ /*border-bottom: 4px solid rgb(255, 215, 181);*/
+ box-shadow: 0 4px 0 0px rgb(255, 215, 181);
+ z-index: 0;
+ @if $ocamlorg {
+ /* Because of fixed banner in the ocaml.org site, we have to offset the targets. See https://stackoverflow.com/questions/10732690/offsetting-an-html-anchor-to-adjust-for-fixed-header */
+ padding-top: 85px;
+ margin-top: -85px;
+ }
+ }
+
+
+ h2:target {
+ /* background: linear-gradient(to bottom, rgb(253, 252, 252) 0%, rgba(255, 215, 181, 0.3) 100%) !important; */
+ /* transition: 300ms; this prevents margin-top:-80 to work... */
+ }
+
+ *:hover>a.section-anchor {
+ visibility: visible;
+ }
+
+ a.section-anchor:before {
+ content: "#"
+ }
+
+ a.section-anchor:hover {
+ box-shadow: none;
+ text-decoration: none;
+ color: #555;
+ }
+
+ a.section-anchor {
+ visibility: hidden;
+ position: absolute;
+ /* top: 0px; */
+ /* margin-left: -3ex; */
+ margin-left: -1.3em;
+ font-weight: normal;
+ font-style: normal;
+ padding-right: 0.4em;
+ padding-left: 0.4em;
+ /* To remain selectable */
+ color: #d5d5d5;
+ }
+
+ .spec > a.section-anchor {
+ margin-left: -2.3em;
+ padding-right: 0.9em;
+ }
+
+ .xref-unresolved {
+ color: #92370A
+ }
+ .xref-unresolved:hover {
+ box-shadow: 0 1px 0 0 #CC6666;
+ }
+
+ /* Section and document divisions.
+ Until at least 4.03 many of the modules of the stdlib start at .h7,
+ we restart the sequence there like h2 */
+
+ h1, h2, h3, h4, h5, h6, .h7, .h8, .h9, .h10 {
+ font-family: "Fira Sans", Helvetica, Arial, sans-serif;
+ font-weight: 400;
+ margin: 0.5em 0 0.5em 0;
+ padding-top: 0.1em;
+ line-height: 1.2;
+ overflow-wrap: break-word;
+ }
+
+ h1 {
+ margin-top: 1.214em;
+ margin-bottom: 19px;
+ font-weight: 500;
+ font-size: 1.953em;
+ box-shadow: 0 1px 0 0 #ddd;
+ }
+
+ h2 {
+ font-size: 1.563em;
+ margin: 1em 0 1em 0
+ }
+
+ h3 {
+ font-size: 1.25em;
+ }
+
+ small, .font_small {
+ font-size: 0.8em;
+ }
+
+ h1 code, h1 tt {
+ font-size: inherit;
+ font-weight: inherit;
+ }
+
+ h2 code, h2 tt {
+ font-size: inherit;
+ font-weight: inherit;
+ }
+
+ h3 code, h3 tt {
+ font-size: inherit;
+ font-weight: inherit;
+ }
+
+ h3 code, h3 tt {
+ font-size: inherit;
+ font-weight: inherit;
+ }
+
+ h4 {
+ font-size: 1.12em;
+ }
+
+
+ /* Preformatted and code */
+
+ tt, code, pre {
+ font-family: "Fira Mono", courier;
+ font-weight: 400;
+ }
+
+ pre {
+ border-left: 4px solid #e69c7f;
+ white-space: pre-wrap;
+ word-wrap: break-word;
+ padding-left: 1ex;
+ }
+
+ p code, li code { /* useful ? */
+ background-color: #ebf2f9; /*#f6f8fa;*/
+ color: #0d2b3e;
+ border-radius: 3px;
+ padding: 0 0.3ex;
+ white-space: pre-wrap; // utile seulement dans la table index_values? (attention à bootstrap.css)
+ }
+
+ pre code {
+ background-color: inherit;
+ }
+
+ p a > code {
+ color: #92370A;
+ }
+
+ /* Code blocks (e.g. Examples) */
+
+ pre code.ocaml {
+ font-size: 0.893rem;
+ }
+
+ /* Code lexemes */
+
+ .keyword {
+ font-weight: 500;
+ color: inherit;
+ }
+
+ /* Module member specification */
+
+ .spec:not(.include), .spec.include details summary {
+ background: linear-gradient(to left, rgb(253, 252, 252) 0%, rgb(234, 246, 250) 100%);
+ border-radius: 3px;
+ border-left: 4px solid #5c9cf5;
+ border-right: 5px solid transparent;
+ padding: 0.35em 0.5em;
+ }
+
+ .spec.include details summary:hover {
+ background-color: #ebeff2;
+ }
+
+ dl, div.spec, .doc, aside {
+ margin-bottom: 20px;
+ }
+
+ dl > dd {
+ padding: 0.5em;
+ }
+
+ dd> :first-child {
+ margin-top: 0;
+ }
+
+ dd > p:first-child > code:first-child {
+ color: teal;
+ }
+
+ dl:last-child, dd> :last-child, aside:last-child, article:last-child {
+ margin-bottom: 0;
+ }
+
+ dt+dt {
+ margin-top: 15px;
+ }
+
+ section+section, section > header + dl {
+ margin-top: 25px;
+ }
+
+ .spec.type .variant {
+ margin-left: 2ch;
+ }
+ .spec.type .variant p {
+ margin: 0;
+ font-style: italic;
+ }
+ .spec.type .record {
+ margin-left: 2ch;
+ }
+ .spec.type .record p {
+ margin: 0;
+ font-style: italic;
+ }
+
+ div.def {
+ margin-top: 0;
+ text-indent: -2ex;
+ padding-left: 2ex;
+ }
+
+ div.def+div.doc {
+ margin-left: 1ex;
+ margin-top: 2.5px
+ }
+
+ div.doc>*:first-child {
+ margin-top: 0;
+ }
+
+ /* The elements other than heading should be wrapped in <aside> elements. */
+ /* heading, body>p, body>ul, body>ol, h3, h4, body>pre { */
+ /* margin-bottom: 30px; */
+ /* } */
+
+ /* Collapsible inlined include and module */
+
+ .spec.include details {
+ position: relative;
+ }
+
+ .spec.include details:after {
+ z-index: -100;
+ display: block;
+ content: " ";
+ position: absolute;
+ border-radius: 0 1ex 1ex 0;
+ right: -20px;
+ top: 1px;
+ bottom: 1px;
+ width: 15px;
+ background: rgba(0, 4, 15, 0.05);
+ box-shadow: 0 0px 0 1px rgba(204, 204, 204, 0.53);
+ }
+
+ .spec.include details summary {
+ position: relative;
+ margin-bottom: 20px;
+ cursor: pointer;
+ outline: none;
+ }
+
+ /* FIXME: Does not work in Firefox. */
+ details summary::-webkit-details-marker {
+ color: #888;
+ transform: scaleX(-1);
+ position: absolute;
+ top: calc(50% - 5px);
+ height: 11px;
+ right: -29px;
+ }
+
+ td.doc *:first-child {
+ margin-top: 0em
+ }
+
+ /* @ tags */
+
+ ul.at-tag {
+ list-style-type: none;
+ margin-left: 0;
+ padding: 0;
+ }
+
+ ul.at-tag li {
+ margin-left: 0;
+ padding: 0;
+ }
+
+ ul.at-tag li p:first-child {
+ margin-top: 0
+ }
+
+ /* FIXME remove */
+
+ span.at-tag {
+ font-weight: bold
+ }
+
+ span.warning,
+ .at-tag.deprecated {
+ font-weight: normal;
+ color: #8eaf20;
+ }
+
+ span.warning {
+ margin-right: 1ex;
+ }
+
+ .at-tag.raise {
+ font-weight: bold;
+ }
+
+ /* FIXME random other things to review. */
+
+ .heading {
+ margin-top: 10px;
+ border-bottom: solid;
+ border-width: 1px;
+ border-color: #DDD;
+ text-align: right;
+ font-weight: normal;
+ font-style: italic;
+ }
+
+ .heading+.sig {
+ margin-top: -20px;
+ }
+
+ .heading+.parameters {
+ margin-top: -20px;
+ }
+
+ /* Odig package index */
+
+ .by-name ol, .by-tag ol, .errors ol {
+ list-style-type: none;
+ margin-left: 0;
+ }
+
+ .by-name ol ol, .by-tag ol ol {
+ margin-top: 0;
+ margin-bottom: 0
+ }
+
+ .by-name li, .by-tag li, .errors li {
+ margin-left: 0;
+ }
+
+ .by-name .version {
+ font-size: 10px;
+ color: #AAA
+ }
+
+ .by-name nav {
+ margin-bottom: 10px
+ }
+
+ .by-name nav a {
+ text-transform: uppercase;
+ font-size: 18px;
+ margin-right: 1ex;
+ color: #222;
+ display: inline-block;
+ }
+
+ .by-tag nav a {
+ margin-right: 1ex;
+ color: #222;
+ display: inline-block;
+ }
+
+ .by-tag>ol>li {
+ margin-top: 10px;
+ }
+
+ .by-tag>ol>li>span, .by-tag>ol>li>ol, .by-tag>ol>li>ol>li {
+ display: inline-block;
+ margin-right: 1ex;
+ }
+
+ /* Odig package page */
+
+ .package nav {
+ display: inline;
+ font-size: 14px;
+ font-weight: normal;
+ }
+
+ .package .version {
+ font-size: 14px;
+ }
+
+ h1+.modules, h1+.sel {
+ margin-top: 10px
+ }
+
+ .sel {
+ font-weight: normal;
+ font-style: italic;
+ font-size: 14px;
+ margin-top: 20px;
+ }
+
+ .sel+.modules {
+ margin-top: 10px;
+ margin-bottom: 20px;
+ margin-left: 1ex;
+ }
+
+ .modules {
+ margin: 0;
+ }
+
+ .modules .module {
+ min-width: 8ex;
+ padding-right: 2ex
+ }
+
+ .package.info {
+ margin: 0;
+ }
+
+ .package.info td:first-child {
+ font-style: italic;
+ padding-right: 2ex;
+ }
+
+ .package.info ul {
+ list-style-type: none;
+ display: inline;
+ margin: 0;
+ }
+
+ .package.info li {
+ display: inline-block;
+ margin: 0;
+ margin-right: 1ex;
+ }
+
+ #info-authors li, #info-maintainers li {
+ display: block;
+ }
+
+ /* lists in the main text */
+ ul.itemize {
+ list-style: none;
+ }
+
+ ul.itemize li::before {
+ content: "▶";
+ color: $logocolor;
+ margin-right: 4px;
+ margin-left: -1em;
+ }
+
+ /* Sidebar and TOC */
+
+ /*.toc ul:before */
+ .toc_title
+ {
+ display: block;
+ /*content: "Contents";*/
+ /* text-transform: uppercase; */
+ margin: 1.414em 0 0.5em;
+ }
+
+ .toc_title a {
+ color: #777;
+ font-size: 1em;
+ line-height: 1.2;
+ font-weight: 500;
+ }
+
+ .toc {
+ @include nav-toc;
+ &.brand {
+ @include brand;
+ }
+ }
+
+ .toc input#api_search {
+ width: 85%;
+ font-family: inherit;
+ }
+
+ .toc #search_results {
+ font-size: smaller;
+ ul {
+ li {
+ margin-bottom: 0;
+
+ }
+ a {
+ display: inline-block;
+ padding-left: 0;
+ }
+ }
+ }
+
+ .ocaml {
+ background: linear-gradient(to left, white 0%, rgb(243, 247, 246) 100%);
+ }
+
+ span.arrow {
+ font-size: 20px;
+ line-height: 8pt;
+ font-family: "Fira Mono";
+ }
+ header dl dd, header dl dt {
+ display: inline-block;
+ }
+ pre {
+ background: linear-gradient(to left, white 0%, rgb(237, 232, 229) 100%);
+ }
+
+ #search_results li.match::before {
+ content: "▶";
+ font-size: smaller;
+ color: $logocolor;
+ float: left;
+ margin-left: -3ex;
+ }
+
+ code.caml-example,
+ div.caml-example, div.toplevel {
+ /* background: linear-gradient(to left, white 0%, rgb(243, 247, 246) 100%); */
+ }
+
+ div.caml-output.ok,
+ code.caml-output.ok,
+ span.c006 {
+ color: #045804;
+ }
+
+ code.caml-output.error,
+ div.caml-output.error {
+ color: orangered;
+ }
+ .tutorial span {
+ color: $logocolor;
+ }
+
+ ul.tutos_menu {
+ font-family: "Fira Sans";
+ text-align: right;
+ list-style: none;
+ }
+
+ ul.tutos_menu li.active a {
+ color: black;
+ }
+
+ nav.toc {
+
+ }
+
+ span.c003 {
+ font-family: "Fira Mono", courier;
+ background-color: #f3ece6;
+ border-radius: 6px;
+ }
+
+ div.caml-example.toplevel div.caml-input::before,
+ div.caml-example.toplevel code.caml-input::before
+ {
+ content:"#";
+ color:#888;
+ }
+
+ span.c004 {
+ color: #888;
+ }
+
+ span.c009 {
+ font-style: italic;
+ }
+
+ code span.keyword,
+ .caml-input span.kw {
+ font-weight: 500;
+ color: #444;
+ }
+
+ code span.keywordsign {
+ color:#92370a;
+ }
+
+ .caml-input span.kw1 {
+ font-weight: 500;
+ color: #777;
+ }
+
+ code span.constructor,
+ .caml-input span.kw2 {
+ font-weight: 500;
+ color: #a28867;
+ }
+
+ .caml-input span.numeric {
+ color: #0086b3;
+ }
+
+ .caml-input span.id {
+ color: #523b74;
+ }
+
+ code span.string,
+ .caml-input span.string {
+ color: #df5000;
+ }
+
+ .caml-input span.comment {
+ color: #969896;
+ }
+
+ .copyright {
+ margin-top: 1em;
+ font-size: smaller;
+ }
+
+ .dt-thefootnotes {
+ float: left;
+ }
+
+ ul.info-attributes {
+ margin-top: 0ex;
+ margin-bottom: 1.5em;
+ list-style: none;
+ }
+
+ /* pour l'API */
+ hr {
+ margin-bottom: 2em;
+ visibility: hidden;
+ }
+
+ code.type {
+ color: #8d543c;
+ }
+
+ td div.info p {
+ margin: 0;
+ box-shadow: 0 1px 0 0 #ddd;
+ }
+ td div.info { /* index page */
+ padding-left: 0;
+ }
+
+ > #search_results {
+ margin-top: 2em;
+ }
+
+ input#api_search {
+ font-family: inherit;
+ }
+
+ #search_results {
+ ul {
+ list-style: none;
+ li {
+ margin-bottom: 4px;
+ }
+ }
+
+ li div.info { /* index page */
+ display: block;
+ max-width: 70%;
+ padding-left: 4em;
+ margin-bottom: 1ex;
+ }
+
+ li div.info p { /* index page */
+ margin: 0;
+ }
+ }
+
+ span.search_comment {
+ vertical-align: bottom;
+ }
+
+ .search_comment .search_help {
+ height: 0;
+ opacity: 0;
+ font-size: 10px;
+ overflow: hidden;
+ transition: all 0.5s;
+ ul {
+ margin-top: 0;
+ }
+ }
+ .search_comment:hover .search_help {
+ height: auto;
+ margin-top:-1px;
+ opacity: 0.8;
+ background: linear-gradient(to bottom, white 0%, rgb(237, 232, 229) 100%);
+ transition: all 0.5s;
+ }
+ .search_comment .search_help:hover {
+ font-size: 14px;
+ }
+
+
+ td div.info div.info-desc {
+ margin-bottom: 0;
+ }
+
+ div.info div.info-desc {
+ margin-bottom: 2ex;
+ padding-left: 2em;
+ }
+
+ div.info.top div.info-desc {
+ padding-left: 0;
+ padding-bottom: 1em;
+ box-shadow: 0 1px 0 0 #ddd;
+ }
+
+ td div.info {
+ margin: 0;
+ }
+
+ div.info-deprecated {
+ padding-top: 0.5em;
+ }
+
+ .info-desc p {
+ margin-bottom: 0;
+ code {
+ white-space: normal;
+ }
+ }
+
+ td.typefieldcomment > code {
+ display: none; /* this only applies to "(*" and "*)" */
+ }
+
+ td.typefieldcomment {
+ padding: 0;
+ }
+
+ td.typefieldcomment p {
+ color: #776558;
+ }
+
+ td.typefieldcomment:nth-child(3), /* should apply to "(*" */
+ td.typefieldcomment:last-child /* should apply to "*)" */
+ {
+ display: none;
+ }
+
+ .api_search img {
+ height: 1em;
+ vertical-align: middle;
+ margin-right: 1em;
+ }
+
+ nav .api_search img {
+ margin-right: 0;
+ }
+
+}
+
+
+#footer {
+ margin-left: 26ex;
+}
+
+
+/* When the navigation bar is collapsed */
+// this should match with ocamlorg.css
+@media only screen and (max-width: 979px) {
+ @include mobile;
+ .container, .api {
+ margin-left: auto;
+ margin-right: auto;
+ }
+ @include sidebar-button;
+ header {
+ @include header-mobile;
+ }
+
+ .api>table {
+ box-shadow: 0px 3px 9px 3px #ddd;
+ margin-bottom: 1em;
+ padding-bottom: 2px;
+ td:nth-child(2) {
+ width: 59%;
+ }
+ }
+
+ .api {
+ *:target {
+ padding-top: 0px;
+ margin-top: 0px;
+ }
+
+ .toc {
+ @include nav-toc-mobile;
+ }
+
+ table td {
+ padding-left: 2%;
+ }
+
+ table td:first-child {
+ padding-right: 0;
+ }
+
+ table.typetable {
+ box-shadow: none;
+ td:nth-child(2) {
+ white-space: normal;
+ /*width: 41%;*/
+ width: auto;
+ max-width: calc(100% - 3ex);
+ }
+ tr td:nth-child(4).typefieldcomment {
+ /*width: 50%;*/
+ width: auto;
+ margin-left: 3ex;
+ word-break: break-word;
+ float: right;
+ }
+ td:last-child {
+ width: auto;
+ }
+ tr td:first-child {
+ padding-right: 0;
+ width: auto;
+ }
+ }
+
+ .info-desc p code {
+ word-break: break-word;
+ }
+
+ td div.info div.info-desc {
+ padding-left: 0;
+ }
+ span.search_comment {
+ display: block;
+ }
+ }
+ .api>table td:first-child {
+ width: 40%;
+ }
+
+ .api {
+ code {
+ word-break: break-word;
+ white-space: pre-wrap;
+ }
+ }
+
+ #footer {
+ margin-left: auto;
+ }
+}
+
+
+
+/* When the navigation bar has reduced size */
+@if $ocamlorg {
+ @media (max-height: 600px) and (min-width: 980px) {
+ .api *:target {
+ padding-top: 60px;
+ margin-top: -60px;
+ }
+ .api nav.toc {
+ top: 46px;
+ }
+ }
+}
+
--- /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
+(library
+ (name common)
+ (modules common)
+ (libraries lambdasoup))
+
+(executable
+ (name process_api)
+ (modules process_api)
+ (libraries unix re lambdasoup common))
+
+(executable
+ (name process_manual)
+ (modules process_manual)
+ (libraries re lambdasoup common))
--- /dev/null
+(* ------------ Ocaml Web-manual -------------- *)
+
+(* Copyright San Vu Ngoc, 2020
+
+ file: process_api.ml
+
+ Post-processing the HTML of the OCaml API. *)
+
+open Soup
+open Printf
+open Common
+
+let compiler_libref = ref false
+(* set this to true to process compilerlibref instead of libref *)
+
+type config = {
+ src_dir : string;
+ dst_dir : string;
+ title : string
+}
+
+(* HTML code for the search widget. We don't add the "onchange" event because it
+ 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>|}
+ else "" in
+ sprintf {|<div class="api_search"><input type="text" name="apisearch" id="api_search" class="api_search"
+ oninput = "mySearch(%b);"
+ onkeypress = "this.oninput();"
+ onclick = "this.oninput();"
+ onpaste = "this.oninput();">
+<img src="search_icon.svg" alt="Search" class="api_search svg" onclick="mySearch(%b)">%s</div>
+<div id="search_results"></div>|} with_description with_description search_decription
+ |> parse
+
+(* We save parsed files in a table; this is just for speed optimization,
+ especially for make_index (18sec instead of 50sec for the whole index); it
+ can be removed. Although if we really wanted a fast make_index, we would use
+ Scanf all over the place ==> 1sec. Warning: the parsed files will be mutated
+ by processing, so one should never process the same file twice. *)
+
+let parsed_files = Hashtbl.create 50
+
+let parse_file ?(original=false) file =
+ match Hashtbl.find_opt parsed_files file with
+ | Some soup ->
+ if original then failwith (sprintf "File %s was already processed" file)
+ else soup
+ | None ->
+ let soup = read_file file |> parse in
+ Hashtbl.add parsed_files file soup;
+ soup
+
+(* Create TOC with H2 and H3 elements *)
+(* Cf Scanf for an example with H3 elements *)
+let make_toc ~version ~search file config title body =
+ let header = create_element ~id:"sidebar" "header" in
+ prepend_child body header;
+ let nav = create_element "nav" ~class_:"toc" in
+ append_child header nav;
+ let ul = create_element "ul" in
+ append_child nav ul;
+ (* Create a "li" element inside "ul" from a header "h" (h2 or h3 typically) *)
+ let li_of_h ul h =
+ let li_current = create_element "li" in
+ append_child ul li_current;
+ let () = match attribute "id" h with
+ | Some id ->
+ let href = "#" ^ id in
+ let a = create_element "a" ~inner_text:(texts h |> String.concat "")
+ ~attributes:["href", href] in
+ append_child li_current a
+ | None -> () in
+ li_current in
+
+ descendants body
+ |> elements
+ |> fold (fun (li_current, h3_current) h -> match name h with
+ | "h2" ->
+ li_of_h ul h, None
+ | "h3" -> begin match h3_current with
+ | Some h3 ->
+ li_of_h h3 h, h3_current
+ | None ->
+ let h3 = create_element "ul" in
+ append_child ul li_current;
+ append_child li_current h3;
+ li_of_h h3 h, Some h3
+ end
+ | _ -> li_current, h3_current) (create_element "li", None);
+ |> ignore;
+
+ let href = let base = Filename.basename file in
+ if String.sub base 0 5 = "type_"
+ then String.sub base 5 (String.length base - 5) else "#top" in
+ let a = create_element "a" ~inner_text:title ~attributes:["href", href] in
+ let div = create_element ~class_:"toc_title" "div" in
+ append_child div a;
+ prepend_child nav div;
+
+ (* In case of indexlist, add it to TOC *)
+ (* This only happens for "index.html" *)
+ let () = match body $? "ul.indexlist" with
+ | Some uli ->
+ delete uli;
+ append_child ul uli;
+ unwrap uli;
+ if search then search_widget true |> prepend_child body;
+ create_element "h1" ~inner_text:
+ (sprintf "The OCaml %sAPI" config.title)
+ |> prepend_child body;
+ | None ->
+ if search then search_widget false |> prepend_child nav;
+ (* Add "general index" link to all other files *)
+ create_element "a" ~inner_text:"< General Index"
+ ~attributes:["href", "index.html"]
+ |> prepend_child nav in
+
+ (* Add version number *)
+ add_version_link nav (config.title ^ "API Version " ^ version) releases_url;
+
+ (* Add sidebar button for mobile navigation *)
+ add_sidebar_button body;
+
+ (* Add logo *)
+ prepend_child header (logo_html
+ ((if config.title = "" then "" else "../") ^
+ (manual_page_url ^ "/index.html")))
+
+
+let process ?(search=true) ~version config file out =
+
+ dbg "Processing %s..." file;
+ let soup = parse_file ~original:true file in
+
+ (* Add javascript and favicon *)
+ update_head ~search soup;
+
+ (* Add api wrapper *)
+ let body = wrap_body ~classes:["api"] soup in
+
+ (* Delete previous/up/next links *)
+ body $? "div.navbar"
+ |> Option.iter delete;
+
+ (* Add left sidebar with TOC *)
+ let title = soup $ "title" |> R.leaf_text in
+ make_toc ~version ~search file config title body;
+
+ dbg "Saving %s..." out;
+
+ (* Save new html file *)
+ let new_html = to_string soup in
+ write_file out new_html
+
+let process ?(overwrite=false) ~version config file out =
+ if overwrite || not (Sys.file_exists out)
+ then Ok (process ~version config file out)
+ else Error (sprintf "File %s already exists." out)
+
+let all_html_files config =
+ Sys.readdir config.src_dir |> Array.to_list
+ |> List.filter (fun s -> Filename.extension s = ".html")
+
+
+module Index = struct
+ (* Generate the index.js file for searching with the quick search widget *)
+ (* The idea is to parse the file "index_values.html" to extract, for each
+ entry of this index, the following information (list of 8 strings):
+
+ [Module name; href URL of the Module (in principle an html file); Value
+ name; href URL of the value; short description (html format); short
+ description in txt format; type signature (html format); type signature in
+ txt format]
+
+ The "txt format" versions are used for searching, the "html version" for
+ display. The signature is not in the "index_values.html" file, we have to
+ look for it by following the value href. The index_values.html file has
+ the following structure:
+
+ (...)
+
+ <table>
+
+ (...)
+
+ <tr><td><a href="List.html#VALappend">append</a> [<a
+ href="List.html">List</a>]</td> <td><div class="info"> <p>Concatenate two
+ lists.</p>
+
+ </div> </td></tr>
+
+ (...)
+
+ </table>
+
+ (...)
+
+ So we need to visit "List.html#VALappend", which has the following
+ structure:
+
+ <pre><span id="VALappend"><span class="keyword">val</span> append</span> :
+ <code class="type">'a list -> 'a list -> 'a list</code></pre>
+
+ and we finally return
+
+ ["List"; "List.html"; "rev_append"; "List.html#VALrev_append"; "<div
+ class=\"info\"> <p><code class=\"code\"><span
+ class=\"constructor\">List</span>.rev_append l1 l2</code>
+ reverses <code class=\"code\">l1</code> and concatenates it to <code
+ class=\"code\">l2</code>.</p> </div>"; "
+ List.rev_append\194\160l1\194\160l2 reverses l1 and concatenates it to
+ l2. "; "<code class=\"type\">'a list -> 'a list -> 'a list</code>";
+ "'a list -> 'a list -> 'a list"]
+
+ *)
+
+ type item =
+ { html : string; txt : string }
+
+ type entry =
+ { mdule : item;
+ value : item;
+ info : item;
+ signature : item option }
+
+ let anon_t_regexp = Re.Str.regexp "\\bt\\b"
+ let space_regexp = Re.Str.regexp " +"
+ let newline_regexp = Re.Str.regexp_string "\n"
+
+ (* Remove "\n" and superfluous spaces in string *)
+ let one_line s =
+ Re.Str.global_replace newline_regexp " " s
+ |> Re.Str.global_replace space_regexp " "
+ |> String.trim
+
+ (* Look for signature (with and without html formatting);
+ [id] is the HTML id of the value. Example:
+ # get_sig ~id_name:"VALfloat_of_int" "Stdlib.html";;
+ Looking for signature for VALfloat_of_int in Stdlib.html
+ Signature=[int -> float]
+ - : (string * string) option =
+ Some ("<code class=\\\"type\\\">int -> float</code>", "int -> float")
+ *)
+ let get_sig ?mod_name ~id_name config file =
+ dbg "Looking for signature for %s in %s" id_name file;
+ let soup = parse_file (config.src_dir // file) in
+ (* Now we jump to the html element with id=id_name. Warning, we cannot use
+ the CSS "#id" syntax for searching the id -- like in: soup $ ("#" ^ id)
+ -- because it can have problematic chars like id="VAL( * )" *)
+ let span = soup $$ "pre span"
+ |> filter (fun s -> id s = Some id_name)
+ |> first |> require in
+ let pre = match parent span with
+ | None -> failwith ("Cannot find signature for " ^ id_name)
+ | Some pre -> pre in
+ let code = pre $ ".type" in
+ let sig_txt = texts code
+ |> String.concat ""
+ |> String.escaped in
+ (* We now replace anonymous "t"'s by the qualified "Module.t" *)
+ let sig_txt = match mod_name with
+ | None -> sig_txt
+ | Some mod_name ->
+ Re.Str.global_replace anon_t_regexp (mod_name ^ ".t") sig_txt in
+ dbg "Signature=[%s]" sig_txt;
+ Some {html = to_string code |> String.escaped; txt = sig_txt}
+
+ (* Example: "Buffer.html#VALadd_subbytes" ==> Some "VALadd_subbytes" *)
+ let get_id ref =
+ match String.split_on_char '#' ref with
+ | [file; id] -> Some (file, id)
+ | _ -> dbg "Could not find id for %s" ref; None
+
+ let make ?(with_sig = true) config =
+ let soup = parse_file (config.src_dir // "index_values.html") in
+ soup $ "table"
+ |> select "tr"
+ |> fold (fun index_list tr ->
+ let td_list = tr $$ "td" |> to_list in
+ match td_list with
+ (* We scan the row; it should contain 2 <td> entries, except for
+ separators with initials A,B,C,D; etc. *)
+ | [td_val; td_info] ->
+ let mdule, value = match td_val $$ ">a" |> to_list with
+ | [a_val; a_mod] ->
+ { txt = R.leaf_text a_mod; html = R.attribute "href" a_mod },
+ { txt = R.leaf_text a_val; html = R.attribute "href" a_val }
+ | _ -> failwith "Cannot parse value" in
+ let info = match td_info $? "div.info" with
+ | Some info -> { html = to_string info
+ |> one_line
+ |> String.escaped;
+ txt = texts info
+ |> String.concat ""
+ |> one_line
+ |> String.escaped }
+ | None -> { html = ""; txt = ""} in
+ let signature =
+ if with_sig then
+ get_id value.html
+ |> flat_option (fun (file,id_name) ->
+ assert (file = mdule.html);
+ get_sig config ~mod_name:mdule.txt ~id_name file)
+ else None in
+ { mdule; value; info; signature } :: index_list
+ | _ ->
+ dbg "Ignoring row:";
+ dbg "%s" (List.map to_string td_list |> String.concat " ");
+ index_list) []
+
+ let save file index =
+ let outch = open_out file in
+ output_string outch "var GENERAL_INDEX = [\n";
+ List.iter (fun item ->
+ fprintf outch {|["%s", "%s", "%s", "%s", "%s", "%s", "%s", "%s"],|}
+ item.mdule.txt item.mdule.html item.value.txt item.value.html
+ item.info.html item.info.txt
+ (Option.map (fun i -> i.html) item.signature |> string_of_opt)
+ (Option.map (fun i -> i.txt) item.signature |> string_of_opt);
+ output_string outch "\n") index;
+ output_string outch "]\n";
+ close_out outch
+
+ let process config =
+ print_endline "Creating index file, please wait...";
+ let t = Unix.gettimeofday () in
+ let index = make config in
+ dbg "Index created. Time = %f\n" (Unix.gettimeofday () -. t);
+ save (config.dst_dir // "index.js") index;
+ dbg "Index saved. Time = %f\n" (Unix.gettimeofday () -. t)
+
+end (* of Index module *)
+
+let process_html config overwrite version =
+ print_endline (sprintf "\nProcessing version %s into %s...\n" version config.dst_dir);
+ let processed = ref 0 in
+ all_html_files config
+ |> List.iter (fun file ->
+ match process config ~overwrite ~version
+ (config.src_dir // file)
+ (config.dst_dir // file) with
+ | Ok () -> incr processed
+ | Error s -> dbg "%s" s
+ );
+ sprintf "Version %s, HTML processing done: %u files have been processed."
+ version !processed |> print_endline
+
+let copy_files config =
+ let ind = config.dst_dir // "index.js" in
+ if not (Sys.file_exists ind) then Index.process config
+
+(******************************************************************************)
+
+let () =
+ let version = find_version () in
+ let args = Sys.argv |> Array.to_list |> List.tl in
+ let config = if List.mem "compiler" args
+ then { src_dir = html_maindir // "compilerlibref";
+ dst_dir = api_dir // "compilerlibref"; title = "Compiler "}
+ else { src_dir = html_maindir // "libref";
+ dst_dir = api_dir; title = ""} in
+ let overwrite = List.mem "overwrite" args in
+ let makeindex = List.mem "makeindex" args in
+ let makehtml = List.mem "html" args || not makeindex in
+ if makehtml then process_html config overwrite version;
+ if makeindex then Index.process config;
+ copy_files config;
+ print_endline "DONE."
+
+(*
+ Local Variables:
+ compile-command:"dune build"
+ End:
+*)
--- /dev/null
+(* ------------ Ocaml Web-manual -------------- *)
+
+(* Copyright San Vu Ngoc, 2020
+
+ file: process_api.ml
+
+ Post-processing the HTML of the OCaml Manual.
+
+ (The "API" side is treated by process_api.ml) *)
+
+open Soup
+open Printf
+open Common
+
+(* How the main index.html page will be called: *)
+let index_title = "Home"
+
+(* Alternative formats for the manual: *)
+let archives =
+ ["refman-html.tar.gz"; "refman.txt"; "refman.pdf"; "refman.info.tar.gz"]
+
+(* Remove number: "Chapter 1 The core language" ==> "The core language" *)
+let remove_number s =
+ Re.Str.(global_replace (regexp ".+ ") "" s)
+
+let toc_get_title li =
+ let a = li $ "a[href]" in
+ let title = trimmed_texts a |> String.concat " "
+ |> remove_number in
+ let file = R.attribute "href" a
+ |> String.split_on_char '#'
+ |> List.hd in
+ file, title
+
+let register_toc_entry toc_table name li =
+ let file, title = toc_get_title li in
+ dbg "%s : %s" name title;
+ if not (Hashtbl.mem toc_table file)
+ then begin
+ Hashtbl.add toc_table file title;
+ dbg "Registering %s => %s" file title
+ end;
+ file, title
+
+(* Scan manual001.html and return two things:
+ 1. [toc_table]: a table with (file ==> title)
+ 2. [all_chapters]: the list of parts: (part_title, chapters), where
+ chapters is a list of (title, file) *)
+let parse_toc () =
+ let toc_table = Hashtbl.create 50 in
+ Hashtbl.add toc_table "manual001.html" "Contents";
+ Hashtbl.add toc_table "foreword.html" "Foreword";
+ Hashtbl.add toc_table "manual071.html" "Keywords";
+
+ let soup = read_file (html_file "manual001.html") |> parse in
+ let toc = soup $ "ul.toc" in
+ let all_chapters =
+ toc $$ ">li.li-toc" (* Parts *)
+ |> fold (fun all_chapters li ->
+ let _file, title = toc_get_title li in
+ dbg "Part: %s " title;
+ let chapters =
+ li $$ ">ul >li.li-toc" (* Chapters *)
+ |> fold (fun chapters li ->
+ let file, title = register_toc_entry toc_table " Chapters" li in
+ li $$ ">ul >li.li-toc" (* Sections *)
+ |> iter (ignore << (register_toc_entry toc_table " Section"));
+ (file,title) :: chapters) []
+ |> List.rev in
+ if chapters = [] then all_chapters
+ else (title, chapters) :: all_chapters) [] in
+ toc_table, all_chapters
+
+(* This string is updated by [extract_date] *)
+let copyright_text = ref "Copyright © 2020 Institut National de Recherche en Informatique et en Automatique"
+
+let copyright () =
+ "<div class=\"copyright\">" ^ !copyright_text ^ "</div>"
+ |> parse
+
+let load_html file =
+ dbg "%s" file;
+ (* First we perform some direct find/replace in the html string. *)
+ let html =
+ read_file (html_file file)
+ (* Normalize non-break spaces: *)
+ |> Re.Str.(global_replace (regexp_string " ") " ")
+ |> Re.Str.(global_replace (regexp "Chapter \\([0-9]+\\)"))
+ (if file = "index.html" then "<span>\\1.</span>"
+ else "<span>Chapter \\1</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. *)
+
+ (* |> Re.Str.global_replace (Re.Str.regexp_string "chapter") "tutorial"
+ * |> Re.Str.global_replace (Re.Str.regexp_string "Chapter") "Tutorial" *)
+
+ (* Remove the chapter number in local links, it makes the TOC unnecessarily
+ unfriendly. *)
+ |> Re.Str.(global_replace (regexp ">[0-9]+\\.\\([0-9]+\\) ") ">\\1 ")
+ |> Re.Str.(global_replace (regexp "[0-9]+\\.\\([0-9]+\\.[0-9]+\\) "))
+ "\\1 "
+
+ (* The API (libref and compilerlibref directories) should be separate
+ entities, to better distinguish them from the manual. *)
+ |> Re.Str.(global_replace (regexp_string "\"libref/"))
+ (sprintf "\"%s/" api_page_url)
+ |> Re.Str.(global_replace (regexp_string "\"compilerlibref/")
+ (sprintf "\"%s/compilerlibref/" api_page_url))
+ in
+
+ (* For the main index file, we do a few adjustments *)
+ let html = if file = "index.html"
+ then Re.Str.(global_replace (regexp "Part \\([I|V]+\\)<br>")
+ "<span>\\1. </span>" html)
+ else html in
+
+ (* Set utf8 encoding directly in the html string *)
+ let charset_regexp = Re.Str.regexp "charset=\\([-A-Za-z0-9]+\\)\\(\\b\\|;\\)" in
+ match Re.Str.search_forward charset_regexp html 0 with
+ | exception Not_found -> dbg "Warning, no charset found in html."; html
+ | _ -> match (String.lowercase_ascii (Re.Str.matched_group 1 html)) with
+ | "utf-8" -> dbg "Charset is UTF-8; good."; html
+ | "us-ascii" -> dbg "Charset is US-ASCII. We change it to UTF-8";
+ Re.Str.global_replace charset_regexp "charset=UTF-8\\2" html
+ | _ -> dbg "Warning, charset not recognized."; html
+
+(* Save new html file *)
+let save_to_file soup file =
+ let new_html = to_string soup in
+ write_file (docs_file file) new_html
+
+(* Find title associated with file *)
+let file_title file toc =
+ if file = "index.html" then Some index_title
+ else Hashtbl.find_opt toc file
+
+(* Replace the images of one of the "previous, next, up" link by the title of
+ the reference. *)
+let nav_replace_img_by_text toc alt a img =
+ let file = R.attribute "href" a in
+ let title = match file_title file toc with
+ | Some f -> begin match alt with
+ | "Previous" -> "« " ^ f
+ | "Next" -> f ^ " »"
+ | "Up" -> f
+ | _ -> failwith "This should not happen"
+ end
+ | None -> dbg "Unknown title for file %s" file; file in
+ let txt = create_text title in
+ replace img txt;
+ add_class (String.lowercase_ascii alt) a
+
+(* Replace three links "Previous, Up, Next" at the end of the file by more
+ useful titles, and insert then in a div container, keeping only 2 of them:
+ either (previous, next) or (previous, up) or (up, next). Remove them at the
+ top of the file, where they are not needed because we have the TOC. *)
+let update_navigation soup toc =
+ Option.iter delete (soup $? "hr");
+ let links =
+ ["Previous"; "Up"; "Next"]
+ |> List.map (fun alt -> alt, to_list (soup $$ ("img[alt=\"" ^ alt ^ "\"]")))
+ (* In principle [imgs] will contain either 0 or 2 elements. *)
+ |> List.filter (fun (_alt, imgs) -> List.length imgs = 2)
+ (* We delete the first link, and replace image by text *)
+ |> List.map (fun (alt, imgs) ->
+ delete (R.parent (List.hd imgs));
+ let img = List.hd (List.rev imgs) in
+ let a = R.parent img in
+ nav_replace_img_by_text toc alt a img;
+ a) in
+ if links <> [] then begin
+ (* We keep only 2 links: first and last *)
+ let a1, a2 = match links with
+ | [prev;up;next] -> delete up; (prev, next)
+ | [a;b] -> (a,b)
+ | _ -> failwith "Navigation link should have at least 2 elements" in
+ add_class "previous" a1;
+ add_class "next" a2;
+ (* some elements can have both previous and up classes, for instance. This
+ helps css styling. *)
+ let container = create_element ~class_:"bottom-navigation" "div" in
+ wrap a1 container;
+ append_child container a2
+ end
+
+
+(* extract the cut point (just after title) and the header of soup:
+ "insert_xfile_content" needs them to insert external files after the cut point,
+ and include the TOC. *)
+let make_template soup =
+ let header = soup $ "header" in
+ let title = match soup $? "div.maintitle" with
+ | Some div -> div (* This is the case for "index.html" *)
+ | None -> soup $ "h1" in
+ title, header
+
+(* Create a new file by keeping only the head/headers parts of "soup", deleting
+ everything after the title, and inserting the content of external file (hence
+ preserving TOC and headers) (WARNING: this mutates soup) *)
+let insert_xfile_content soup (title, header) toc xfile =
+ let xternal = parse (load_html xfile) in
+ update_navigation xternal toc;
+ Option.iter delete (xternal $? "hr");
+ let xbody = xternal $ "body" in
+ insert_after title xbody;
+ create_element ~id:"start-section" "a"
+ |> insert_after title;
+ insert_after title header;
+ next_siblings xbody
+ |> iter delete;
+ insert_after xbody (copyright ());
+ set_name "section" xbody;
+ set_attribute "id" "section" xbody;
+ save_to_file soup xfile
+
+(* Extract the date (and copyright) from the maintitle block in "index.html" *)
+let extract_date maintitle =
+ let months = ["January"; "February"; "March"; "April";
+ "May"; "June"; "July"; "August"; "September";
+ "October"; "November"; "December"] in
+ let txts = texts maintitle
+ |> List.map String.trim in
+ copyright_text := List.hd (List.rev txts);
+ txts
+ |> List.filter (fun s -> List.exists (fun month -> starts_with month s) months)
+ |> function | [s] -> Some s
+ | _ -> dbg "Warning, date not found"; None
+
+(* Special treatment of the main index.html file *)
+let convert_index version soup =
+ (* Remove "translated from LaTeX" *)
+ soup $$ "blockquote" |> last |> Option.iter delete;
+ let title_selector = if float_of_string version < 4.07
+ then "div.center" else "div.maintitle" in
+ let maintitle = soup $ title_selector in
+ sprintf "<div class=\"maintitle\"><h1><span>The OCaml system</span> release %s </h1><h3>%s</h3></div>"
+ version (extract_date maintitle |> string_of_opt)
+ |> parse
+ |> insert_after maintitle ;
+ delete maintitle;
+ let body = soup $ ".index" in
+ {|<span class="authors">Xavier Leroy,<br> Damien Doligez, Alain Frisch, Jacques Garrigue, Didier Rémy and Jérôme Vouillon</span>|}
+ |> parse
+ |> append_child body
+
+let change_title title soup =
+ let title_tag = soup $ "title" in
+ let new_title = create_element "title" ~inner_text:("OCaml - " ^ title) in
+ replace title_tag new_title
+
+(* Create left sidebar for TOC. *)
+let make_toc_sidebar ~version ~title file body =
+ let toc = match body $? "ul" with
+ | None -> None (* can be None, eg chapters 15,19...*)
+ | Some t -> if classes t <> [] (* as in libthreads.html or parsing.html *)
+ then (dbg "We don't promote <UL> to TOC for file %s" file; None)
+ else Some t in
+
+ let () = match body $? "h2.section", toc with
+ | None, Some toc ->
+ (* If file has "no content" (sections), we clone the toc to leave it in
+ the main content. This applies to "index.html" as well. *)
+ let original_toc = parse (to_string toc) in
+ original_toc $ "ul"
+ |> add_class "ul-content";
+ insert_after toc original_toc
+ | _ -> () in
+
+ let nav = create_element "nav" ~class_:"toc" in
+ let () = match toc with
+ | None -> prepend_child body nav
+ | Some toc -> wrap toc nav in
+ let nav = body $ "nav" in
+ wrap nav (create_element ~id:"sidebar" "header");
+ begin match toc with
+ | None -> dbg "No TOC for %s" file
+ | Some toc -> begin
+ (* TOC - Create a title entry in the menu *)
+ let a = create_element "a" ~inner_text:title
+ ~attributes:["href", "#"] in
+ let li = create_element "li" ~class_:"top" in
+ append_child li a;
+ prepend_child toc li;
+
+ (* index of keywords *)
+ if file = "index.html"
+ then begin
+ let keywords =
+ body $$ "ul"
+ |> fold (fun key ul ->
+ match key with
+ | None -> begin
+ match ul $$ "li" |> last with
+ | None -> None
+ | Some l -> begin match l $ "a" |> leaf_text with
+ | Some text -> dbg "[%s]" text;
+ if text = "Index of keywords"
+ then l $ "a" |> attribute "href" else None
+ | None -> None
+ end
+ end
+ | _ -> key) None in
+ begin match keywords with
+ | None -> dbg "Could not find Index of keywords"
+ | Some keywords ->
+ let a = create_element "a" ~inner_text:"Index of keywords"
+ ~attributes:["href", keywords] in
+ let li = create_element "li" in
+ (append_child li a;
+ append_child toc li)
+ end;
+ (* Link to APIs *)
+ let a = create_element "a" ~inner_text:"OCaml API"
+ ~attributes:["href", api_page_url ^ "/index.html"] in
+ let li = create_element "li" in
+ (append_child li a;
+ append_child toc li);
+ let a = create_element "a" ~inner_text:"OCaml Compiler API"
+ ~attributes:["href", api_page_url ^ "/compilerlibref/index.html"] in
+ let li = create_element "li" in
+ (append_child li a;
+ append_child toc li)
+ end
+ end
+ end;
+
+ (* Add back link to "OCaml Manual" *)
+ if file <> "index.html" then begin
+ let toc_title = create_element "div" ~class_:"toc_title" in
+ let a = create_element "a" ~inner_text:"< The OCaml Manual"
+ ~attributes:["href", "index.html"] in
+ append_child toc_title a;
+ prepend_child nav toc_title
+ end;
+
+ (* Add version number *)
+ let version_text = if file = "index.html" then "Select another version"
+ else "Version " ^ version in
+ add_version_link nav version_text releases_url;
+ toc
+
+ (* Create menu for all chapters in the part *)
+let make_part_menu ~part_title chapters file body =
+ let menu = create_element "ul" ~id:"part-menu" in
+ List.iter (fun (href, title) ->
+ let a = create_element "a" ~inner_text:title ~attributes:["href", href] in
+ let li = if href = file
+ then create_element "li" ~class_:"active"
+ else create_element "li" in
+ append_child li a;
+ append_child menu li) chapters;
+ prepend_child body menu;
+
+ (* Add part_title just before the part-menu *)
+ if part_title <> "" then begin
+ let nav = create_element ~id:"part-title" "nav" ~inner_text:part_title in
+ create_element "span" ~inner_text:"☰"
+ |> prepend_child nav;
+ prepend_child body nav
+ end
+
+(* Add logo *)
+let add_logo file soup =
+ match soup $? "header" with
+ | None -> dbg "Warning: no <header> for %s" file
+ | Some header -> prepend_child header (logo_html "https://ocaml.org/")
+
+(* Move authors to the end *)
+let move_authors body =
+ body $? "span.c009"
+ |> Option.iter (fun authors ->
+ match leaf_text authors with
+ | None -> ()
+ | Some s ->
+ match Re.Str.(search_forward (regexp "(.+written by.+)") s 0) with
+ | exception Not_found -> ()
+ | _ ->
+ dbg "Moving authors";
+ delete authors;
+ add_class "authors" authors;
+ append_child body authors)
+
+(* Get the list of external files linked by the current file *)
+let get_xfiles = function
+ | None -> []
+ | Some toc ->
+ toc $$ "li"
+ |> fold (fun list li ->
+ let rf = li $ "a" |> R.attribute "href" in
+ dbg "TOC reference = %s" rf;
+ if not (String.contains rf '#') &&
+ not (starts_with ".." rf) &&
+ not (starts_with "http" rf)
+ then begin
+ li $ "a" |> set_attribute "href" (rf ^ "#start-section");
+ rf::list
+ end else list) []
+
+(* This is the main script for processing a specified file. [convert] has to be
+ run for each "entry" [file] of the manual, making a "Chapter". (The list of
+ [chapters] corresponds to a "Part" of the manual.) *)
+let convert version (part_title, chapters) toc_table (file, title) =
+ dbg "%s ==> %s" (html_file file) (docs_file file);
+
+ (* Parse html *)
+ let soup = parse (load_html file) in
+
+ (* Change title, add javascript and favicon *)
+ change_title title soup;
+ update_head soup;
+
+ (* Wrap body. *)
+ let c = if file = "index.html" then ["manual"; "content"; "index"]
+ else ["manual"; "content"] in
+ let body = wrap_body ~classes:c soup in
+
+ if file = "index.html" then convert_index version soup;
+
+ (* Make sidebar *)
+ let toc = make_toc_sidebar ~version ~title file body in
+
+ (* Make top menu for chapters *)
+ make_part_menu ~part_title chapters file body;
+
+ (* Add side-bar button before part_title *)
+ add_sidebar_button body;
+
+ (* Add logo *)
+ add_logo file soup;
+
+ (* Move authors to the end *)
+ move_authors body;
+
+ (* Bottom navigation links *)
+ update_navigation soup toc_table;
+
+ (* Add copyright *)
+ append_child body (copyright ());
+
+ (* Save html *)
+ save_to_file soup file;
+
+ (* Finally, generate external files to be converted (this should be done at
+ the end because it deeply mutates the original soup) *)
+ let xfiles = get_xfiles toc in
+ let template = make_template soup in
+ List.iter (insert_xfile_content soup template toc_table) xfiles
+
+
+(* Completely process the given version of the manual. Returns the names of the
+ main html files. *)
+let process version =
+ print_endline (sprintf "\nProcessing version %s into %s...\n" version docs_maindir);
+
+ dbg "Current directory is: %s" (Sys.getcwd ());
+
+ dbg "* Scanning index";
+ let toc_table, all_chapters = parse_toc () in
+
+ (* special case of the "index.html" file: *)
+ convert version ("", []) toc_table ("index.html", "The OCaml Manual");
+
+ let main_files = List.fold_left (fun list (part_title, chapters) ->
+ dbg "* Processing chapters for %s" part_title;
+ List.iter (convert version (part_title, chapters) toc_table) chapters;
+ (fst (List.hd chapters)) :: list) [] all_chapters in
+
+ main_files
+
+(******************************************************************************)
+
+let () =
+ let _list = process (find_version ()) in
+ print_endline "DONE."
+
+(*
+ Local Variables:
+ compile-command:"dune build"
+ End:
+*)
$(COMPILER_LIBS_PLUGIN_HOOKS)
OTHERLIB_INTF = Unix.tex UnixLabels.tex Str.tex \
- Thread.tex Mutex.tex Condition.tex Event.tex ThreadUnix.tex \
+ Thread.tex Mutex.tex Condition.tex Semaphore.tex Event.tex \
Dynlink.tex Bigarray.tex
INTF = $(CORE_INTF) $(STDLIB_INTF) $(COMPILER_LIBS_INTF) $(OTHERLIB_INTF)
BLURB = core.tex builtin.tex stdlib-blurb.tex compilerlibs.tex \
- libunix.tex libstr.tex libnum.tex libgraph.tex \
- libthreads.tex libdynlink.tex libbigarray.tex
+ libunix.tex libstr.tex old.tex \
+ libthreads.tex libdynlink.tex
FILES = $(BLURB) $(INTF)
"Stdlib" module, without adding a "open Stdlib" directive.
\end{itemize}
+\begin{latexonly}
\section*{s:core-conventions}{Conventions}
The declarations of the built-in types and the components of module
"Stdlib" are printed one by one in typewriter font, followed by a
short comment. All library modules and the components they provide are
indexed at the end of this report.
+\end{latexonly}
\input{builtin.tex}
\ifouthtml
+++ /dev/null
-\chapter{The bigarray library}
-%HEVEA\cutname{libbigarray.html}
-
-The "bigarray" library has now been integrated into OCaml's standard
-library.
-
-The "bigarray" functionality may now be found in the standard library
-\ifouthtml
- \ahref{libref/Bigarray.html}{\texttt{Bigarray} module},
-\else
- \texttt{Bigarray} module,
-\fi
-except for the "map_file" function which is now
-part of the \hyperref[c:unix]{Unix library}. The documentation has
-been integrated into the documentation for the standard library.
-
-The legacy "bigarray" library bundled with the compiler is a
-compatibility library with exactly the same interface as before,
-i.e. with "map_file" included.
-
-We strongly recommend that you port your code to use the standard
-library version instead, as the changes required are minimal.
-
-If you choose to use the compatibility library, you must link your
-programs as follows:
-\begin{alltt}
- ocamlc \var{other options} bigarray.cma \var{other files}
- ocamlopt \var{other options} bigarray.cmxa \var{other files}
-\end{alltt}
-For interactive use of the "bigarray" compatibility library, do:
-\begin{alltt}
- ocamlmktop -o mytop bigarray.cma
- ./mytop
-\end{alltt}
-or (if dynamic linking of C libraries is supported on your platform),
-start "ocaml" and type "#load \"bigarray.cma\";;".
+++ /dev/null
-\chapter{The graphics library}
-%HEVEA\cutname{libgraph.html}
-
-Since OCaml 4.09, the "graphics" library is distributed as an external
-package. Its new home is:
-
-\url{https://github.com/ocaml/graphics}
-
-If you are using the opam package manager, you should install the
-corresponding "graphics" package:
-
-\begin{alltt}
- opam install graphics
-\end{alltt}
-
-Before OCaml 4.09, this package simply ensures that the "graphics"
-library was installed by the compiler, and starting from OCaml 4.09
-this package effectively provides the "graphics" library.
+++ /dev/null
-\chapter{The num library: arbitrary-precision rational arithmetic}
-%HEVEA\cutname{libnum.html}
-
-The "num" library implements integer arithmetic and rational
-arithmetic in arbitrary precision. It was split off the core
-OCaml distribution starting with the 4.06.0 release, and can now be found
-at \url{https://github.com/ocaml/num}.
-
-New applications that need arbitrary-precision arithmetic should use the
-"Zarith" library (\url{https://github.com/ocaml/Zarith}) instead of the "Num"
-library, and older applications that already use "Num" are encouraged to
-switch to "Zarith". "Zarith" delivers much better performance than "Num"
-and has a nicer API.
\label{c:threads}\cutname{threads.html}
%HEVEA\cutname{libthreads.html}
-\textbf{Warning:} the "threads" library is deprecated since version
-4.08.0 of OCaml. Please switch to system threads, which have the same
-API. Lightweight threads with VM-level scheduling are provided by
-third-party libraries such as Lwt, but with a different API.
-
The "threads" library allows concurrent programming in OCaml.
It provides multiple threads of control (also called lightweight
processes) that execute concurrently in the same memory space. Threads
communicate by in-place modification of shared data structures, or by
sending and receiving data on communication channels.
-The "threads" library is implemented by time-sharing on a single
-processor. It will not take advantage of multi-processor machines.
-Using this library will therefore never make programs run
-faster. However, many programs are easier to write when structured as
-several communicating processes.
+The "threads" library is implemented on top of the threading
+facilities provided by the operating system: POSIX 1003.1c threads for
+Linux, MacOS, and other Unix-like systems; Win32 threads for Windows.
+Only one thread at a time is allowed to run OCaml code, hence
+opportunities for parallelism are limited to the parts of the program
+that run system or C library code. However, threads provide
+concurrency and can be used to structure programs as several
+communicating processes. Threads also efficiently support concurrent,
+overlapping I/O operations.
-Two implementations of the "threads" library are available, depending
-on the capabilities of the operating system:
-\begin{itemize}
-\item System threads. This implementation builds on the OS-provided threads
-facilities: POSIX 1003.1c threads for Unix, and Win32 threads for
-Windows. When available, system threads support both bytecode and
-native-code programs.
-\item VM-level threads. This implementation performs time-sharing and
-context switching at the level of the OCaml virtual machine (bytecode
-interpreter). It is available on Unix systems, and supports only
-bytecode programs. It cannot be used with native-code programs.
-\end{itemize}
-Programs that use system threads must be linked as follows:
+Programs that use threads must be linked as follows:
\begin{alltt}
ocamlc -I +threads \var{other options} unix.cma threads.cma \var{other files}
ocamlopt -I +threads \var{other options} unix.cmxa threads.cmxa \var{other files}
\item \ahref{libref/Thread.html}{Module \texttt{Thread}: lightweight threads}
\item \ahref{libref/Mutex.html}{Module \texttt{Mutex}: locks for mutual exclusion}
\item \ahref{libref/Condition.html}{Module \texttt{Condition}: condition variables to synchronize between threads}
+\item \ahref{libref/Semaphore.html}{Module \texttt{Semaphore}: semaphores, another thread synchronization mechanism}
\item \ahref{libref/Event.html}{Module \texttt{Event}: first-class synchronous communication}
-\item \ahref{libref/ThreadUnix.html}{Module \texttt{ThreadUnix}: thread-compatible system calls}
\end{links}
\else
\input{Thread.tex}
\input{Mutex.tex}
\input{Condition.tex}
+\input{Semaphore.tex}
\input{Event.tex}
-\input{ThreadUnix.tex}
\fi
or (if dynamic linking of C libraries is supported on your platform),
start "ocaml" and type "#load \"unix.cma\";;".
+\begin{latexonly}
\begin{windows}
A fairly complete emulation of the Unix system calls is provided in
the Windows version of OCaml. The end of this chapter gives
more information on the functions that are not supported under Windows.
\end{windows}
-\begin{latexonly}
{
\ocamldocinputstart
\input{Unix.tex}
Below is a list of the functions that are not implemented, or only
partially implemented, by the Win32 ports. Functions not mentioned are
fully implemented and behave as described previously in this chapter.
+\end{windows}
\begin{tableau}{|l|p{8cm}|}{Functions}{Comment}
\entree{"fork"}{not implemented, use "create_process" or threads}
\entree{"waitpid"}{can only wait for a given PID, not any child process}
\entree{"getppid"}{not implemented (meaningless under Windows)}
\entree{"nice"}{not implemented}
-\entree{"truncate", "ftruncate"}{not implemented}
+\entree{"truncate", "ftruncate"}{implemented (since 4.10.0)}
\entree{"link"}{implemented (since 3.02)}
-\entree{"symlink", "readlink"}{implemented (since 4.03.0)}
-\entree{"access"}{execute permission "X_OK" cannot be tested,
- it just tests for read permission instead}
\entree{"fchmod"}{not implemented}
\entree{"chown", "fchown"}{not implemented (make no sense on a DOS
file system)}
\entree{"umask"}{not implemented}
+\entree{"access"}{execute permission "X_OK" cannot be tested,
+ it just tests for read permission instead}
+\entree{"chroot"}{not implemented}
\entree{"mkfifo"}{not implemented}
+\entree{"symlink", "readlink"}{implemented (since 4.03.0)}
\entree{"kill"}{partially implemented (since 4.00.0): only the "sigkill" signal
is implemented}
+\entree{"sigprocmask", "sigpending", "sigsuspend"}{not implemented (no inter-process signals on Windows}
\entree{"pause"}{not implemented (no inter-process signals in Windows)}
\entree{"alarm"}{not implemented}
\entree{"times"}{partially implemented, will not report timings for child
processes}
\entree{"getitimer", "setitimer"}{not implemented}
\entree{"getuid", "geteuid", "getgid", "getegid"}{always return 1}
+\entree{"setuid", "setgid", "setgroups", "initgroups"}{not implemented}
\entree{"getgroups"}{always returns "[|1|]" (since 2.00)}
-\entree{"setuid", "setgid", "setgroups"}{not implemented}
\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 }
\entree{"establish_server"}{not implemented; use threads}
\entree{terminal functions ("tc*")}{not implemented}
+\entree{"setsid"}{not implemented}
\end{tableau}
-
-\end{windows}
--- /dev/null
+\chapter{Recently removed or moved libraries (Graphics, Bigarray, Num, LablTk)}
+%HEVEA\cutname{old.html}
+
+This chapter describes three libraries which were formerly part of the OCaml
+distribution (Graphics, Num, and LablTk), and a library which has now become
+part of OCaml's standard library, and is documented there (Bigarray).
+
+
+\section{s:graphics-removed}{The Graphics Library}
+
+Since OCaml 4.09, the "graphics" library is distributed as an external
+package. Its new home is:
+
+\url{https://github.com/ocaml/graphics}
+
+If you are using the opam package manager, you should install the
+corresponding "graphics" package:
+
+\begin{alltt}
+ opam install graphics
+\end{alltt}
+
+Before OCaml 4.09, this package simply ensures that the "graphics"
+library was installed by the compiler, and starting from OCaml 4.09
+this package effectively provides the "graphics" library.
+
+\section{s:bigarray-moved}{The Bigarray Library}
+
+As of OCaml 4.07, the "bigarray" library has been integrated into OCaml's
+standard library.
+
+The "bigarray" functionality may now be found in the standard library
+\ifouthtml
+ \ahref{libref/Bigarray.html}{\texttt{Bigarray} module},
+\else
+ \texttt{Bigarray} module,
+\fi
+except for the "map_file" function which is now
+part of the \hyperref[c:unix]{Unix library}. The documentation has
+been integrated into the documentation for the standard library.
+
+The legacy "bigarray" library bundled with the compiler is a
+compatibility library with exactly the same interface as before,
+i.e. with "map_file" included.
+
+We strongly recommend that you port your code to use the standard
+library version instead, as the changes required are minimal.
+
+If you choose to use the compatibility library, you must link your
+programs as follows:
+\begin{alltt}
+ ocamlc \var{other options} bigarray.cma \var{other files}
+ ocamlopt \var{other options} bigarray.cmxa \var{other files}
+\end{alltt}
+For interactive use of the "bigarray" compatibility library, do:
+\begin{alltt}
+ ocamlmktop -o mytop bigarray.cma
+ ./mytop
+\end{alltt}
+or (if dynamic linking of C libraries is supported on your platform),
+start "ocaml" and type "#load \"bigarray.cma\";;".
+
+\section{s:graphics-removed}{The Num Library}
+
+The "num" library implements integer arithmetic and rational
+arithmetic in arbitrary precision. It was split off the core
+OCaml distribution starting with the 4.06.0 release, and can now be found
+at \url{https://github.com/ocaml/num}.
+
+New applications that need arbitrary-precision arithmetic should use the
+"Zarith" library (\url{https://github.com/ocaml/Zarith}) instead of the "Num"
+library, and older applications that already use "Num" are encouraged to
+switch to "Zarith". "Zarith" delivers much better performance than "Num"
+and has a nicer API.
+
+\section{s:labltk-removed}{The Labltk Library and OCamlBrowser}
+
+Since OCaml version 4.02, the OCamlBrowser tool and the Labltk library
+are distributed separately from the OCaml compiler. The project is now
+hosted at \url{https://github.com/garrigue/labltk}.
\label{stdlib:top}
+\begin{latexonly}
+
\section*{s:stdlib-conv}{Conventions}
For easy reference, the modules are listed below in alphabetical order
All modules and the identifiers they export are indexed at the end of
this report.
-\begin{latexonly}
\section*{s:stdlib-overview}{Overview}
Here is a short listing, by theme, of the standard library modules.
"Int" & p.~\pageref{Int} & integer values \\
"Option" & p.~\pageref{Option} & option values \\
"Result" & p.~\pageref{Result} & result values \\
+"Either" & p.~\pageref{Either} & either values \\
"Hashtbl" & p.~\pageref{Hashtbl} & hash tables and hash functions \\
"Random" & p.~\pageref{Random} & pseudo-random number generator \\
"Set" & p.~\pageref{Set} & sets over ordered types \\
"Lazy" & p.~\pageref{Lazy} & delayed evaluation \\
"Weak" & p.~\pageref{Weak} & references that don't prevent objects
from being garbage-collected \\
+"Atomic" & p.~\pageref{Atomic} & atomic references (for compatibility with concurrent runtimes) \\
"Ephemeron" & p.~\pageref{Ephemeron} & ephemerons and weak hash tables \\
"Bigarray" & p.~\pageref{Bigarray} & large, multi-dimensional, numerical arrays
\end{tabular}
\subsubsection*{sss:stdlib-arith}{Arithmetic:}
\begin{tabular}{lll}
-"Complex" & p.~\pageref{Complex} & Complex numbers \\
-"Float" & p.~\pageref{Float} & Floating-point numbers \\
+"Complex" & p.~\pageref{Complex} & complex numbers \\
+"Float" & p.~\pageref{Float} & floating-point numbers \\
"Int32" & p.~\pageref{Int32} & operations on 32-bit integers \\
"Int64" & p.~\pageref{Int64} & operations on 64-bit integers \\
"Nativeint" & p.~\pageref{Nativeint} & operations on platform-native
integers
\end{tabular}
-\subsubsection{sss:stdlib-io}{Input/output:}
+\subsubsection*{sss:stdlib-io}{input/output:}
\begin{tabular}{lll}
"Format" & p.~\pageref{Format} & pretty printing with automatic
indentation and line breaking \\
"Scanf" & p.~\pageref{Scanf} & formatted input functions \\
"Digest" & p.~\pageref{Digest} & MD5 message digest \\
\end{tabular}
-\subsubsection{sss:stdlib-parsing}{Parsing:}
+\subsubsection*{sss:stdlib-parsing}{Parsing:}
\begin{tabular}{lll}
"Genlex" & p.~\pageref{Genlex} & a generic lexer over streams \\
"Lexing" & p.~\pageref{Lexing} & the run-time library for lexers generated by "ocamllex" \\
"Parsing" & p.~\pageref{Parsing} & the run-time library for parsers generated by "ocamlyacc" \\
"Stream" & p.~\pageref{Stream} & basic functions over streams \\
\end{tabular}
-\subsubsection{sss:stdlib-system}{System interface:}
+\subsubsection*{sss:stdlib-system}{System interface:}
\begin{tabular}{lll}
"Arg" & p.~\pageref{Arg} & parsing of command line arguments \\
"Callback" & p.~\pageref{Callback} & registering OCaml functions to
"Filename" & p.~\pageref{Filename} & operations on file names \\
"Gc" & p.~\pageref{Gc} & memory management control and statistics \\
"Printexc" & p.~\pageref{Printexc} & a catch-all exception handler \\
-"Spacetime" & p.~\pageref{Spacetime} & memory profiler \\
"Sys" & p.~\pageref{Sys} & system interface \\
\end{tabular}
-\subsubsection{sss:stdlib-misc}{Misc:}
+\subsubsection*{sss:stdlib-misc}{Misc:}
\begin{tabular}{lll}
"Fun" & p.~\pageref{Fun} & function values \\
\end{tabular}
\item \ahref{libref/Arg.html}{Module \texttt{Arg}: parsing of command line arguments}
\item \ahref{libref/Array.html}{Module \texttt{Array}: array operations}
\item \ahref{libref/ArrayLabels.html}{Module \texttt{ArrayLabels}: array operations (with labels)}
+\item \ahref{libref/Atomic.html}{Module \texttt{Atomic}: atomic references}
\item \ahref{libref/Bigarray.html}{Module \texttt{Bigarray}: large, multi-dimensional, numerical arrays}
\item \ahref{libref/Bool.html}{Module \texttt{Bool}: boolean values}
\item \ahref{libref/Buffer.html}{Module \texttt{Buffer}: extensible buffers}
\item \ahref{libref/BytesLabels.html}{Module \texttt{BytesLabels}: byte sequences (with labels)}
\item \ahref{libref/Callback.html}{Module \texttt{Callback}: registering OCaml values with the C runtime}
\item \ahref{libref/Char.html}{Module \texttt{Char}: character operations}
-\item \ahref{libref/Complex.html}{Module \texttt{Complex}: Complex numbers}
+\item \ahref{libref/Complex.html}{Module \texttt{Complex}: complex numbers}
\item \ahref{libref/Digest.html}{Module \texttt{Digest}: MD5 message digest}
+\item \ahref{libref/Either.html}{Module \texttt{Either}: either values}
\item \ahref{libref/Ephemeron.html}{Module \texttt{Ephemeron}: Ephemerons and weak hash table}
\item \ahref{libref/Filename.html}{Module \texttt{Filename}: operations on file names}
-\item \ahref{libref/Float.html}{Module \texttt{Float}: Floating-point numbers}
+\item \ahref{libref/Float.html}{Module \texttt{Float}: floating-point numbers}
\item \ahref{libref/Format.html}{Module \texttt{Format}: pretty printing}
\item \ahref{libref/Fun.html}{Module \texttt{Fun}: function values}
\item \ahref{libref/Gc.html}{Module \texttt{Gc}: memory management control and statistics; finalized values}
\item \ahref{libref/ListLabels.html}{Module \texttt{ListLabels}: list operations (with labels)}
\item \ahref{libref/Map.html}{Module \texttt{Map}: association tables over ordered types}
\item \ahref{libref/Marshal.html}{Module \texttt{Marshal}: marshaling of data structures}
-\item \ahref{libref/MoreLabels.html}{Module \texttt{MoreLabels}: Include modules \texttt{Hashtbl}, \texttt{Map} and \texttt{Set} with labels}
+\item \ahref{libref/MoreLabels.html}{Module \texttt{MoreLabels}: include modules \texttt{Hashtbl}, \texttt{Map} and \texttt{Set} with labels}
\item \ahref{libref/Nativeint.html}{Module \texttt{Nativeint}: processor-native integers}
\item \ahref{libref/Oo.html}{Module \texttt{Oo}: object-oriented extension}
\item \ahref{libref/Option.html}{Module \texttt{Option}: option values}
\item \ahref{libref/Scanf.html}{Module \texttt{Scanf}: formatted input functions}
\item \ahref{libref/Seq.html}{Module \texttt{Seq}: functional iterators}
\item \ahref{libref/Set.html}{Module \texttt{Set}: sets over ordered types}
-\item \ahref{libref/Spacetime.html}{Module \texttt{Spacetime}: memory profiler}
\item \ahref{libref/Stack.html}{Module \texttt{Stack}: last-in first-out stacks}
-\item \ahref{libref/StdLabels.html}{Module \texttt{StdLabels}: Include modules \texttt{Array}, \texttt{List} and \texttt{String} with labels}
+\item \ahref{libref/StdLabels.html}{Module \texttt{StdLabels}: include modules \texttt{Array}, \texttt{List} and \texttt{String} with labels}
\item \ahref{libref/Stream.html}{Module \texttt{Stream}: streams and parsers}
\item \ahref{libref/String.html}{Module \texttt{String}: string operations}
\item \ahref{libref/StringLabels.html}{Module \texttt{StringLabels}: string operations (with labels)}
\input{Arg.tex}
\input{Array.tex}
\input{ArrayLabels.tex}
+\input{Atomic.tex}
\input{Bigarray.tex}
\input{Bool.tex}
\input{Buffer.tex}
\input{Char.tex}
\input{Complex.tex}
\input{Digest.tex}
+\input{Either.tex}
\input{Ephemeron.tex}
\input{Filename.tex}
\input{Float.tex}
\input{Scanf.tex}
\input{Seq.tex}
\input{Set.tex}
-\input{Spacetime.tex}
\input{Stack.tex}
\input{StdLabels.tex}
\input{Stream.tex}
%Styles for caml-example and friends
\newstyle{div.caml-output}{color:maroon;}
% Styles for toplevel mode only
-\newstyle{div.caml-example.toplevel div.caml-input::before}
- {content:"\#"; color:black;}
\newstyle{div.caml-example.toplevel div.caml-input}{color:\#006000;}
%%% Code examples
\newcommand{\output@color}{\maroon}
\newcommand{\machine}{\tt}
\newenvironment{machineenv}{\begin{alltt}}{\end{alltt}}
-\newcommand{\firstline}{\ }
-\newcommand{\examplespace}{\ }
-\newcommand{\nextline}{\examplespace\ }
-\newcommand{\@zyva}{\firstline\renewcommand{\?}{\nextline}}
-\let\?=\@zyva
-\renewcommand{\:}{\renewcommand{\?}{\@zyva}}
\newcommand{\var}[1]{\textit{#1}}
%% Caml-example environment
\newcommand{\camlexample}[1]{
- \ifthenelse{\equal{#1}{toplevel}}
- {\renewcommand{\examplespace}{\ }}
- {\renewcommand{\examplespace}{}}
- \fi
\@open{div}{class="caml-example #1"}
}
\newcommand{\endcamlexample}{
\@close{div}
- \renewcommand{\examplespace}{\ }
}
\newenvironment{caml}{\@open{div}{class=ocaml}}{\@close{div}}
% Caml-example related command
-\newenvironment{camlexample}[1]{
- \ifnum\pdfstrcmp{#1}{toplevel}=0
- \renewcommand{\hash}{\#}
- \else
- \renewcommand{\hash}{}
- \fi
-}{}
+\newenvironment{camlexample}[1]{}{}
\newenvironment{caml}{}{}
\newcommand{\ocamlkeyword}{\bfseries}
\newcommand{\ocamlhighlight}{\bfseries\uline}
\newcommand{\ocamlcomment}{\color{gray}\normalfont\small}
\newcommand{\ocamlstring}{\color{gray}\bfseries}
-\newcommand{\?}{\normalsize\tt\hash{} }
-\renewcommand{\:}{\small\ttfamily\slshape}
-
\makeatother
\newenvironment{machineenv}{\begin{alltt}}{\end{alltt}}
\newenvironment{camlunder}{\@style{U}}{}
\newcommand{\?}{\black\#\blue }
-\renewcommand{\:}{\maroon}
\newcommand{\ocamlkeyword}{\bfseries}
\newcommand{\ocamlhighlight}{\bfseries\underline}
\usepackage[normalem]{ulem}% for underlining errors in code examples
\input{macros.tex}
-\newcommand{\hash}{\#}
\lstnewenvironment{camloutput}{
\lstset{
basicstyle=\small\ttfamily\slshape,
\fi
}{}
-
+\newcommand{\?}{\color{black}\normalsize\tt\#{}}
% Add meta tag to the generated head tag
\ifouthtml
%HEVEA\cutname{extn.html}
This chapter describes language extensions and convenience features
-that are implemented in OCaml, but not described in the
-OCaml reference manual.
+that are implemented in OCaml, but not described in chapter \ref{c:refman}.
%HEVEA\cutdef{section}
&& t4.%{0;0;0;0} = t4.{0,0,0,0}
\end{caml_example*}
-
+Beware that the differentiation between the multi-index and single index
+operators is purely syntactic: multi-index operators are restricted to
+index expressions that contain one or more semicolons ";". For instance,
+\begin{caml_example*}{verbatim}
+ let pair vec mat = vec.%{0}, mat.%{0;0}
+\end{caml_example*}
+is equivalent to
+\begin{caml_example*}{verbatim}
+ let pair vec mat = (.%{ }) vec 0, (.%{;..}) mat [|0;0|]
+\end{caml_example*}
+Notice that in the "vec" case, we are calling the single index operator, "(.%{})", and
+not the multi-index variant, "(.{;..})".
+For this reason, it is expected that most users of multi-index operators will need
+to define conjointly a single index variant
+\begin{caml_example*}{verbatim}
+let (.%{;..}) = A.get
+let (.%{ }) a k = A.get a [|k|]
+\end{caml_example*}
+to handle both cases uniformly.
\section{s:empty-variants}{Empty variant types}
%HEVEA\cutname{emptyvariants.html}
" ] _ ` { {< | |] || } ~"
\end{alltt}
%
-Note that the following identifiers are keywords of the Camlp4
-extensions and should be avoided for compatibility reasons.
+Note that the following identifiers are keywords of the now unmaintained Camlp4
+system and should be avoided for backwards compatibility reasons.
%
\begin{verbatim}
parser value $ $$ $: <: << >> ??
| '(' type-param { "," type-param } ')'
;
type-param:
- [variance] "'" ident
+ [ext-variance] "'" ident
+;
+ext-variance:
+ variance [injectivity]
+ | injectivity [variance]
;
variance:
'+'
| '-'
;
+injectivity: '!'
+;
record-decl:
'{' field-decl { ';' field-decl } [';'] '}'
;
['mutable'] field-name ':' poly-typexpr
;
type-constraint:
- 'constraint' "'" ident '=' typexpr
+ 'constraint' typexpr '=' typexpr
\end{syntax}
\ikwd{mutable\@\texttt{mutable}}
\ikwd{constraint\@\texttt{constraint}}
@"('"ident_1,\ldots,"'"ident_n")"@, for type constructors with several
parameters. Each type parameter may be prefixed by a variance
constraint @"+"@ (resp. @"-"@) indicating that the parameter is
-covariant (resp. contravariant). These type parameters can appear in
+covariant (resp. contravariant), and an injectivity annotation @"!"@
+indicating that the parameter can be deduced from the whole type.
+These type parameters can appear in
the type expressions of the right-hand side of the definition,
optionally restricted by a variance constraint ; {\em i.e.\/} a
covariant parameter may only appear on the right side of a functional
are inferred from its definition, and the variance annotations are
only checked for conformance with the definition.
+Injectivity annotations are only necessary for abstract types and
+private row types, since they can otherwise be deduced from the type
+declaration: all parameters are injective for record and variant type
+declarations (including extensible types); for type abbreviations a
+parameter is injective if it has an injective occurrence in its
+defining equation (be it private or not). For constrained type
+parameters in type abbreviations, they are injective if either they
+appear at an injective position in the body, or if all their type
+variables are injective; in particular, if a constrained type
+parameter contains a variable that doesn't appear in the body, it
+cannot be injective.
+
\ikwd{constraint\@\texttt{constraint}}
The construct @ 'constraint' "'" ident '=' typexpr @ allows the
specification of
object
val mutable table = []
method find key = List.assoc key table
- method add key valeur = table <- (key, valeur) :: table
+ method add key value = table <- (key, value) :: table
end;;
\end{caml_example}
A better implementation, and one that scales up better, is to use a
\chapter{The core language} \label{c:core-xamples}
%HEVEA\cutname{coreexamples.html}
-This part of the manual is a tutorial introduction to the
-OCaml language. A good familiarity with programming in a conventional
-languages (say, C or Java) is assumed, but no prior exposure to
-functional languages is required. The present chapter introduces the
-core language. Chapter~\ref{c:moduleexamples} deals with the
-module system, chapter~\ref{c:objectexamples} with the
-object-oriented features, chapter~\ref{c:labl-examples} with
-extensions to the core language (labeled arguments and polymorphic
-variants), and chapter~\ref{c:advexamples} gives some advanced examples.
+This part of the manual is a tutorial introduction to the OCaml language. A
+good familiarity with programming in a conventional languages (say, C or Java)
+is assumed, but no prior exposure to functional languages is required. The
+present chapter introduces the core language. Chapter~\ref{c:moduleexamples}
+deals with the module system, chapter~\ref{c:objectexamples} with the
+object-oriented features, chapter~\ref{c:labl-examples} with extensions to the
+core language (labeled arguments and polymorphic variants),
+chapter~\ref{c:polymorphism} with the limitations of polymorphism, and
+chapter~\ref{c:advexamples} gives some advanced examples.
\section{s:basics}{Basics}
-For this overview of OCaml, we use the interactive system, which
-is started by running "ocaml" from the Unix shell, or by launching the
-"OCamlwin.exe" application under Windows. This tutorial is presented
-as the transcript of a session with the interactive system:
-lines starting with "#" represent user input; the system responses are
-printed below, without a leading "#".
+For this overview of OCaml, we use the interactive system, which is started by
+running "ocaml" from the Unix shell or Windows command prompt. This tutorial is
+presented as the transcript of a session with the interactive system: lines
+starting with "#" represent user input; the system responses are printed below,
+without a leading "#".
Under the interactive system, the user types OCaml phrases terminated
by ";;" in response to the "#" prompt, and the system compiles them
Phrases are either simple expressions, or "let" definitions of
identifiers (either values or functions).
\begin{caml_example}{toplevel}
-1+2*3;;
+1 + 2 * 3;;
let pi = 4.0 *. atan 1.0;;
let square x = x *. x;;
square (sin pi) +. square (cos pi);;
Recursive functions are defined with the "let rec" binding:
\begin{caml_example}{toplevel}
let rec fib n =
- if n < 2 then n else fib (n-1) + fib (n-2);;
+ if n < 2 then n else fib (n - 1) + fib (n - 2);;
fib 10;;
\end{caml_example}
they operate between any two values of the same type. This makes
"sort" itself polymorphic over all list types.
\begin{caml_example}{toplevel}
-sort [6;2;5;3];;
+sort [6; 2; 5; 3];;
sort [3.14; 2.718];;
\end{caml_example}
\end{caml_example}
At last, it is possible to update few fields of a record at once:
\begin{caml_example}{toplevel}
- let integer_product integer ratio = { ratio with num = integer * ratio.num };;
+let integer_product integer ratio = { ratio with num = integer * ratio.num };;
\end{caml_example}
With this functional update notation, the record on the left-hand side
of "with" is copied except for the fields on the right-hand side which
Secondly, for records, OCaml can also deduce the right record type by
looking at the whole set of fields used in a expression or pattern:
\begin{caml_example}{toplevel}
-let project_and_rotate {x;y; _ } = { x= - y; y = x ; z = 0} ;;
+let project_and_rotate {x; y; _} = { x= - y; y = x; z = 0} ;;
\end{caml_example}
Since the fields "x" and "y" can only appear simultaneously in the first
record type, OCaml infers that the type of "project_and_rotate" is
amongst all locally valid choices:
\begin{caml_example}{toplevel}
-let look_at_xz {x;z} = x;;
+let look_at_xz {x; z} = x;;
\end{caml_example}
Here, OCaml has inferred that the possible choices for the type of
match l with
[] -> raise Empty_list
| hd :: tl -> hd;;
-head [1;2];;
+head [1; 2];;
head [];;
\end{caml_example}
with
| Empty_list -> "no named value"
| Not_found -> first_named_value (List.tl values) names;;
-first_named_value [ 0; 10 ] [ 1, "one"; 10, "ten"];;
+first_named_value [0; 10] [1, "one"; 10, "ten"];;
\end{caml_example}
Also, finalization can be performed by
expression, "2". Let us see how we initialize a lazy expression.
\begin{caml_example}{toplevel}
- let lazy_two = lazy ( print_endline "lazy_two evaluation"; 1 + 1 );;
+let lazy_two = lazy (print_endline "lazy_two evaluation"; 1 + 1);;
\end{caml_example}
We added "print_endline \"lazy_two evaluation\"" to see when the lazy
standard-library module \stdmoduleref{Lazy}.
\begin{caml_example}{toplevel}
- Lazy.force lazy_two;;
+Lazy.force lazy_two;;
\end{caml_example}
Notice that our function call above prints ``lazy_two evaluation'' and then
"<lazy>" anymore but as "lazy 2".
\begin{caml_example}{toplevel}
- lazy_two;;
+lazy_two;;
\end{caml_example}
This is because "Lazy.force" memoizes the result of the forced expression. In other
force "lazy_two" once again.
\begin{caml_example}{toplevel}
- Lazy.force lazy_two;;
+Lazy.force lazy_two;;
\end{caml_example}
The expression is not evaluated this time; notice that ``lazy_two evaluation'' is
Lazy patterns provide another way to force a lazy expression.
\begin{caml_example}{toplevel}
- let lazy_l = lazy ([1; 2] @ [3; 4]);;
- let lazy l = lazy_l;;
+let lazy_l = lazy ([1; 2] @ [3; 4]);;
+let lazy l = lazy_l;;
\end{caml_example}
We can also use lazy patterns in pattern matching.
\begin{caml_example}{toplevel}
- let maybe_eval lazy_guard lazy_expr =
- match lazy_guard, lazy_expr with
- | lazy false, _ -> "matches if (Lazy.force lazy_guard = false); lazy_expr not forced"
- | lazy true, lazy _ -> "matches if (Lazy.force lazy_guard = true); lazy_expr forced";;
+let maybe_eval lazy_guard lazy_expr =
+ match lazy_guard, lazy_expr with
+ | lazy false, _ -> "matches if (Lazy.force lazy_guard = false); lazy_expr not forced"
+ | lazy true, lazy _ -> "matches if (Lazy.force lazy_guard = true); lazy_expr forced";;
\end{caml_example}
The lazy expression "lazy_expr" is forced only if the "lazy_guard" value yields
output more concisely.
It follows the behavior of the "printf" function from the C standard library.
The "printf" function takes a format string that describes the desired output
-as a text interspered with specifiers (for instance "%d", "%f").
+as a text interspersed with specifiers (for instance "%d", "%f").
Next, the specifiers are substituted by the following arguments in their order
of apparition in the format string:
\begin{caml_example}{toplevel}
Printf.printf str 3 4.5 "string value";;
\end{caml_example}
-%%%%%%%%%%% Should be moved to the camlp4 documentation.
-%% Parsing (transforming concrete syntax into abstract syntax) is usually
-%% more delicate. OCaml offers several tools to help write parsers:
-%% on the one hand, OCaml versions of the lexer generator Lex and the
-%% parser generator Yacc (see chapter~\ref{c:ocamlyacc}), which handle
-%% LALR(1) languages using push-down automata; on the other hand, a
-%% predefined type of streams (of characters or tokens) and
-%% pattern-matching over streams, which facilitate the writing of
-%% recursive-descent parsers for LL(1) languages. An example using
-%% "ocamllex" and "ocamlyacc" is given in
-%% chapter~\ref{c:ocamlyacc}. Here, we will use stream parsers.
-%% The syntactic support for stream parsers is provided by the Camlp4
-%% preprocessor, which can be loaded into the interactive toplevel via
-%% the "#load" directives below.
-%%
-%% \begin{caml_example}
-%% #load "dynlink.cma";;
-%% #load "camlp4o.cma";;
-%% open Genlex;;
-%% let lexer = make_lexer ["("; ")"; "+"; "-"; "*"; "/"];;
-%% \end{caml_example}
-%% For the lexical analysis phase (transformation of the input text into
-%% a stream of tokens), we use a ``generic'' lexer provided in the
-%% standard library module "Genlex". The "make_lexer" function takes a
-%% list of keywords and returns a lexing function that ``tokenizes'' an
-%% input stream of characters. Tokens are either identifiers, keywords,
-%% or literals (integer, floats, characters, strings). Whitespace and
-%% comments are skipped.
-%% \begin{caml_example}
-%% let token_stream = lexer (Stream.of_string "1.0 +x");;
-%% Stream.next token_stream;;
-%% Stream.next token_stream;;
-%% Stream.next token_stream;;
-%% \end{caml_example}
-%%
-%% The parser itself operates by pattern-matching on the stream of
-%% tokens. As usual with recursive descent parsers, we use several
-%% intermediate parsing functions to reflect the precedence and
-%% associativity of operators. Pattern-matching over streams is more
-%% powerful than on regular data structures, as it allows recursive calls
-%% to parsing functions inside the patterns, for matching sub-components of
-%% the input stream. See the Camlp4 documentation for more details.
-%%
-%% %Already said above
-%% %In order to use stream parsers at toplevel, we must first load the
-%% %"camlp4" preprocessor.
-%% %\begin{caml_example}
-%% %#load"camlp4o.cma";;
-%% %\end{caml_example}
-%% %Then we are ready to define our parser.
-%% \begin{caml_example}{toplevel}
-%% let rec parse_expr = parser
-%% [< e1 = parse_mult; e = parse_more_adds e1 >] -> e
-%% and parse_more_adds e1 = parser
-%% [< 'Kwd "+"; e2 = parse_mult; e = parse_more_adds (Sum(e1, e2)) >] -> e
-%% | [< 'Kwd "-"; e2 = parse_mult; e = parse_more_adds (Diff(e1, e2)) >] -> e
-%% | [< >] -> e1
-%% and parse_mult = parser
-%% [< e1 = parse_simple; e = parse_more_mults e1 >] -> e
-%% and parse_more_mults e1 = parser
-%% [< 'Kwd "*"; e2 = parse_simple; e = parse_more_mults (Prod(e1, e2)) >] -> e
-%% | [< 'Kwd "/"; e2 = parse_simple; e = parse_more_mults (Quot(e1, e2)) >] -> e
-%% | [< >] -> e1
-%% and parse_simple = parser
-%% [< 'Ident s >] -> Var s
-%% | [< 'Int i >] -> Const(float i)
-%% | [< 'Float f >] -> Const f
-%% | [< 'Kwd "("; e = parse_expr; 'Kwd ")" >] -> e;;
-%% let parse_expression = parser [< e = parse_expr; _ = Stream.empty >] -> e;;
-%% \end{caml_example}
-%%
-%% Composing the lexer and parser, we finally obtain a function to read
-%% an expression from a character string:
-%% \begin{caml_example}
-%% let read_expression s = parse_expression (lexer (Stream.of_string s));;
-%% read_expression "2*(x+y)";;
-%% \end{caml_example}
-%% A small puzzle: why do we get different results in the following two
-%% examples?
-%% \begin{caml_example}
-%% read_expression "x - 1";;
-%% read_expression "x-1";;
-%% \end{caml_example}
-%% Answer: the generic lexer provided by "Genlex" recognizes negative
-%% integer literals as one integer token. Hence, "x-1" is read as
-%% the token "Ident \"x\"" followed by the token "Int(-1)"; this sequence
-%% does not match any of the parser rules. On the other hand,
-%% the second space in "x - 1" causes the lexer to return the three
-%% expected tokens: "Ident \"x\"", then "Kwd \"-\"", then "Int(1)".
-
\section{s:standalone-programs}{Standalone OCaml programs}
All examples given so far were executed under the interactive system.
$ ocamlc -o gcd gcd.ml
$ ./gcd 6 9
3
-$ ./fib 7 11
+$ ./gcd 7 11
1
\end{verbatim}
Chapters~\ref{c:camlc} and~\ref{c:nativecomp} explain how to use the
batch compilers "ocamlc" and "ocamlopt". Recompilation of
multi-file OCaml projects can be automated using third-party
-build systems, such as the
-\href{https://github.com/ocaml/ocamlbuild/}{ocamlbuild}
-compilation manager.
+build systems, such as \href{https://github.com/ocaml/dune}{dune}.
cannot use a reserved keyword (like "in" or "to") as label.
Formal parameters and arguments are matched according to their
-respective labels\footnote{This correspond to the commuting label mode
+respective labels\footnote{This corresponds to the commuting label mode
of Objective Caml 3.00 through 3.02, with some additional flexibility
on total applications. The so-called classic mode ("-nolabels"
options) is now deprecated for normal use.}, the absence of label
When there are several objects of same nature and role, they are all
left unlabeled.
\begin{alltt}
-"ListLabels.iter2 : f:('a -> 'b -> 'c) -> 'a list -> 'b list -> unit"
+"ListLabels.iter2 : f:('a -> 'b -> unit) -> 'a list -> 'b list -> unit"
\end{alltt}
When there is no preferable object, all arguments are labeled.
structure.
\begin{caml_example}{toplevel}
- open PrioQueue;;
- insert empty 1 "hello";;
+open PrioQueue;;
+insert empty 1 "hello";;
\end{caml_example}
Opening a module enables lighter access to its components, at the
to confusing errors:
\begin{caml_example}{toplevel}
- let empty = []
- open PrioQueue;;
- let x = 1 :: empty [@@expect error];;
+let empty = []
+open PrioQueue;;
+let x = 1 :: empty [@@expect error];;
\end{caml_example}
A partial solution to this conundrum is to open modules locally,
making the components of the module available only in the
-concerned expression. This can also make the code easier to read
--- the open statement is closer to where it is used-- and to refactor
--- the code fragment is more self-contained.
+concerned expression. This can also make the code both easier to read
+(since the open statement is closer to where it is used) and easier to refactor
+(since the code fragment is more self-contained).
Two constructions are available for this purpose:
\begin{caml_example}{toplevel}
- let open PrioQueue in
- insert empty 1 "hello";;
+let open PrioQueue in
+insert empty 1 "hello";;
\end{caml_example}
and
\begin{caml_example}{toplevel}
- PrioQueue.(insert empty 1 "hello");;
+PrioQueue.(insert empty 1 "hello");;
\end{caml_example}
In the second form, when the body of a local open is itself delimited
by parentheses, braces or bracket, the parentheses of the local open
can be omitted. For instance,
\begin{caml_example}{toplevel}
- PrioQueue.[empty] = PrioQueue.([empty]);;
- PrioQueue.[|empty|] = PrioQueue.([|empty|]);;
- PrioQueue.{ contents = empty } = PrioQueue.({ contents = empty });;
+PrioQueue.[empty] = PrioQueue.([empty]);;
+PrioQueue.[|empty|] = PrioQueue.([|empty|]);;
+PrioQueue.{ contents = empty } = PrioQueue.({ contents = empty });;
\end{caml_example}
becomes
\begin{caml_example}{toplevel}
- PrioQueue.[insert empty 1 "hello"];;
+PrioQueue.[insert empty 1 "hello"];;
\end{caml_example}
This second form also works for patterns:
\begin{caml_example}{toplevel}
- let at_most_one_element x = match x with
- | PrioQueue.( Empty| Node (_,_, Empty,Empty) ) -> true
- | _ -> false ;;
+let at_most_one_element x = match x with
+| PrioQueue.( Empty| Node (_,_, Empty,Empty) ) -> true
+| _ -> false ;;
\end{caml_example}
It is also possible to copy the components of a module inside
we could add functions that returns an optional value rather than
an exception when the priority queue is empty.
\begin{caml_example}{toplevel}
- module PrioQueueOpt =
- struct
- include PrioQueue
+module PrioQueueOpt =
+struct
+ include PrioQueue
- let remove_top_opt x =
- try Some(remove_top x) with Queue_is_empty -> None
+ let remove_top_opt x =
+ try Some(remove_top x) with Queue_is_empty -> None
- let extract_opt x =
- try Some(extract x) with Queue_is_empty -> None
- end;;
+ let extract_opt x =
+ try Some(extract x) with Queue_is_empty -> None
+end;;
\end{caml_example}
\section{s:signature}{Signatures}
Stdlib | Camlinternal* | *Labels | Obj | Pervasives) continue;;
esac
grep -q -e '"'$i'" & p\.~\\pageref{'$i'} &' $1/manual/manual/library/stdlib-blurb.etex || {
- echo "Module $i is missing from stdlib-blurb.etex." >&2
+ echo "Module $i is missing from library/stdlib-blurb.etex." >&2
exitcode=2
}
done
and uconstant =
| Uconst_ref of string * ustructured_constant option
| Uconst_int of int
- | Uconst_ptr of int
and uphantom_defining_expr =
| Uphantom_const of uconstant
match, because of string constants that must not be
reshared. *)
| Uconst_int n1, Uconst_int n2 -> Stdlib.compare n1 n2
- | Uconst_ptr n1, Uconst_ptr n2 -> Stdlib.compare n1 n2
| Uconst_ref _, _ -> -1
| Uconst_int _, Uconst_ref _ -> 1
- | Uconst_int _, Uconst_ptr _ -> -1
- | Uconst_ptr _, _ -> 1
let rec compare_constant_lists l1 l2 =
match l1, l2 with
and uconstant =
| Uconst_ref of string * ustructured_constant option
| Uconst_int of int
- | Uconst_ptr of int
and uphantom_defining_expr =
| Uphantom_const of uconstant
make_const(Uconst_ref(Compilenv.new_structured_constant ~shared:true c,
Some c))
let make_const_int n = make_const (Uconst_int n)
-let make_const_ptr n = make_const (Uconst_ptr n)
-let make_const_bool b = make_const_ptr(if b then 1 else 0)
+let make_const_bool b = make_const_int(if b then 1 else 0)
let make_integer_comparison cmp x y =
let open Clambda_primitives in
let default = (Uprim(p, args, dbg), Value_unknown) in
match approxs with
(* int (or enumerated type) *)
- | [ Value_const(Uconst_int n1 | Uconst_ptr n1) ] ->
+ | [ Value_const(Uconst_int n1) ] ->
begin match p with
| Pnot -> make_const_bool (n1 = 0)
| Pnegint -> make_const_int (- n1)
| _ -> default
end
(* int (or enumerated type), int (or enumerated type) *)
- | [ Value_const(Uconst_int n1 | Uconst_ptr n1);
- Value_const(Uconst_int n2 | Uconst_ptr n2) ] ->
+ | [ Value_const(Uconst_int n1);
+ Value_const(Uconst_int n2) ] ->
begin match p with
| Psequand -> make_const_bool (n1 <> 0 && n2 <> 0)
| Psequor -> make_const_bool (n1 <> 0 || n2 <> 0)
(* Kind test *)
| Pisint, _, [a1] ->
begin match a1 with
- | Value_const(Uconst_int _ | Uconst_ptr _) -> make_const_bool true
+ | Value_const(Uconst_int _) -> make_const_bool true
| Value_const(Uconst_ref _) -> make_const_bool false
| Value_closure _ | Value_tuple _ -> make_const_bool false
| _ -> (Uprim(p, args, dbg), Value_unknown)
match sarg with
| Uconst (Uconst_ref (_, Some (Uconst_block (tag, _)))) ->
find_action sw.us_index_blocks sw.us_actions_blocks tag
- | Uconst (Uconst_ptr tag) ->
+ | Uconst (Uconst_int tag) ->
find_action sw.us_index_consts sw.us_actions_consts tag
| _ -> None
in
(V.Map.add (VP.var id) (Uvar (VP.var id')) sb) rn u2)
| Uifthenelse(u1, u2, u3) ->
begin match substitute loc st sb rn u1 with
- Uconst (Uconst_ptr n) ->
+ Uconst (Uconst_int n) ->
if n <> 0 then
substitute loc st sb rn u2
else
then app
else Usequence(ufunct, app)
-(* Add [Value_integer] or [Value_constptr] info to the approximation
- of an application *)
+(* Add [Value_integer] info to the approximation of an application *)
let strengthen_approx appl approx =
match approx_ulam appl with
intapprox
| _ -> approx
-(* If a term has approximation Value_integer or Value_constptr and is pure,
+(* If a term has approximation Value_integer and is pure,
replace it by an integer constant *)
let check_constant_result ulam approx =
let rec transl = function
| Const_base(Const_int n) -> Uconst_int n
| Const_base(Const_char c) -> Uconst_int (Char.code c)
- | Const_pointer n -> Uconst_ptr n
| Const_block (tag, fields) ->
str (Uconst_block (tag, List.map transl fields))
| Const_float_array sl ->
kind = Curried;
return = Pgenval;
params = List.map (fun v -> v, Pgenval) final_args;
- body = Lapply{ap_should_be_tailcall=false;
- ap_loc=loc;
- ap_func=(Lvar funct_var);
- ap_args=internal_args;
- ap_inlined=Default_inline;
- ap_specialised=Default_specialise};
+ 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
| Ostype_win32 -> make_const_bool (Sys.os_type = "Win32")
| Ostype_cygwin -> make_const_bool (Sys.os_type = "Cygwin")
| Backend_type ->
- make_const_ptr 0 (* tag 0 is the same as Native here *)
+ make_const_int 0 (* tag 0 is the same as Native here *)
in
let arg, _approx = close env arg in
let id = Ident.create_local "dummy" in
Ulet(Immutable, Pgenval, VP.create id, arg, cst), approx
| Lprim(Pignore, [arg], _loc) ->
- let expr, approx = make_const_ptr 0 in
+ let expr, approx = make_const_int 0 in
Usequence(fst (close env arg), expr), approx
| Lprim((Pidentity | Pbytes_to_string | Pbytes_of_string), [arg], _loc) ->
close env arg
| Lprim(Pdirapply,[funct;arg], loc)
| Lprim(Prevapply,[arg;funct], loc) ->
- close env (Lapply{ap_should_be_tailcall=false;
- ap_loc=loc;
- ap_func=funct;
- ap_args=[arg];
- ap_inlined=Default_inline;
- ap_specialised=Default_specialise})
+ close env
+ (Lapply{
+ ap_loc=loc;
+ ap_func=funct;
+ ap_args=[arg];
+ ap_tailcall=Default_tailcall;
+ ap_inlined=Default_inline;
+ ap_specialised=Default_specialise;
+ })
| Lprim(Pgetglobal id, [], loc) ->
let dbg = Debuginfo.from_location loc in
check_constant_result (getglobal dbg id)
(Utrywith(ubody, VP.create id, uhandler), Value_unknown)
| Lifthenelse(arg, ifso, ifnot) ->
begin match close env arg with
- (uarg, Value_const (Uconst_ptr n)) ->
+ (uarg, Value_const (Uconst_int n)) ->
sequence_constant_expr uarg
(close env (if n = 0 then ifnot else ifso))
| (uarg, _ ) ->
Compilenv.add_exported_constant s;
structured_constant c
| Uconst_ref (_s, None) -> assert false (* Cannot be generated *)
- | Uconst_int _ | Uconst_ptr _ -> ()
+ | Uconst_int _ -> ()
and structured_constant = function
| Uconst_block (_, ul) -> List.iter const ul
| Uconst_float _ | Uconst_int32 _
| export_id -> export_id
let new_unit_descr t =
- new_descr t (Value_constptr 0)
+ new_descr t (Value_int 0)
let add_approx t var approx =
if Variable.Map.mem var t.var then begin
let descr_of_constant (c : Flambda.const) : Export_info.descr =
match c with
- (* [Const_pointer] is an immediate value of a type whose values may be
- boxed (typically a variant type with both constant and non-constant
- constructors). *)
| Int i -> Value_int i
| Char c -> Value_char c
- | Const_pointer i -> Value_constptr i
let descr_of_allocated_constant (c : Allocated_const.t) : Export_info.descr =
match c with
| Value_mutable_block _
| Value_int _
| Value_char _
- | Value_constptr _
| Value_float _
| Value_float_array _
| Value_string _
| Value_mutable_block _
| Value_int _
| Value_char _
- | Value_constptr _
| Value_float _
| Value_float_array _
| Value_string _
Names.const_int64
| Const_base (Const_nativeint c) ->
register_const t (Allocated_const (Nativeint c)) Names.const_nativeint
- | Const_pointer c -> Const (Const_pointer c), Names.const_ptr
| Const_immstring c ->
register_const t (Allocated_const (Immutable_string c))
Names.const_immstring
let lambda_const_bool b : Lambda.structured_constant =
if b then
- Const_pointer 1
+ Lambda.const_int 1
else
- Const_pointer 0
+ Lambda.const_int 0
let lambda_const_int i : Lambda.structured_constant =
Const_base (Const_int i)
in
Flambda.create_let set_of_closures_var set_of_closures
(name_expr (Project_closure (project_closure)) ~name)
- | Lapply { ap_func; ap_args; ap_loc; ap_should_be_tailcall = _;
- ap_inlined; ap_specialised; } ->
+ | Lapply { ap_func; ap_args; ap_loc;
+ ap_tailcall = _; ap_inlined; ap_specialised; } ->
Lift_code.lifting_helper (close_list t env ap_args)
~evaluation_order:`Right_to_left
~name:Names.apply_arg
let arg2 = close t env arg2 in
let const_true = Variable.create Names.const_true in
let cond = Variable.create Names.cond_sequor in
- Flambda.create_let const_true (Const (Const_pointer 1))
+ Flambda.create_let const_true (Const (Int 1))
(Flambda.create_let cond (Expr arg1)
(If_then_else (cond, Var const_true, arg2)))
| Lprim (Psequand, [arg1; arg2], _) ->
let arg2 = close t env arg2 in
let const_false = Variable.create Names.const_false in
let cond = Variable.create Names.const_sequand in
- Flambda.create_let const_false (Const (Const_pointer 0))
+ Flambda.create_let const_false (Const (Int 0))
(Flambda.create_let cond (Expr arg1)
(If_then_else (cond, arg2, Var const_false)))
| Lprim ((Psequand | Psequor), _, _) ->
close_let_bound_expression t var env arg
in
Flambda.create_let var defining_expr
- (name_expr (Const (Const_pointer 0)) ~name:Names.unit)
+ (name_expr (Const (Int 0)) ~name:Names.unit)
| Lprim (Pdirapply, [funct; arg], loc)
| Lprim (Prevapply, [arg; funct], loc) ->
let apply : Lambda.lambda_apply =
{ ap_func = funct;
ap_args = [arg];
ap_loc = loc;
- ap_should_be_tailcall = false;
(* CR-someday lwhite: it would be nice to be able to give
- inlined attributes to functions applied with the application
+ application attributes to functions applied with the application
operators. *)
+ ap_tailcall = Default_tailcall;
ap_inlined = Default_inline;
ap_specialised = Default_specialise;
}
| Ostype_win32 -> lambda_const_bool (String.equal Sys.os_type "Win32")
| Ostype_cygwin -> lambda_const_bool (String.equal Sys.os_type "Cygwin")
| Backend_type ->
- Lambda.Const_pointer 0 (* tag 0 is the same as Native *)
+ Lambda.const_int 0 (* tag 0 is the same as Native *)
end
in
close t env
| Value_mutable_block of Tag.t * int
| Value_int of int
| Value_char of char
- | Value_constptr of int
| Value_float of float
| Value_float_array of value_float_array
| Value_boxed_int : 'a A.boxed_int * 'a -> descr
i1 = i2
| Value_char c1, Value_char c2 ->
c1 = c2
- | Value_constptr i1, Value_constptr i2 ->
- i1 = i2
| Value_float f1, Value_float f2 ->
f1 = f2
| Value_float_array s1, Value_float_array s2 ->
| Value_set_of_closures s1, Value_set_of_closures s2 ->
equal_set_of_closures s1 s2
| ( Value_block (_, _) | Value_mutable_block (_, _) | Value_int _
- | Value_char _ | Value_constptr _ | Value_float _ | Value_float_array _
+ | Value_char _ | Value_float _ | Value_float_array _
| Value_boxed_int _ | Value_string _ | Value_closure _
| Value_set_of_closures _
| Value_unknown_descr ),
( Value_block (_, _) | Value_mutable_block (_, _) | Value_int _
- | Value_char _ | Value_constptr _ | Value_float _ | Value_float_array _
+ | Value_char _ | Value_float _ | Value_float_array _
| Value_boxed_int _ | Value_string _ | Value_closure _
| Value_set_of_closures _
| Value_unknown_descr ) ->
fprintf ppf "(Value_mutable-block (%a %d))" Tag.print tag i
| Value_int i -> fprintf ppf "(Value_int %d)" i
| Value_char c -> fprintf ppf "(Value_char %c)" c
- | Value_constptr p -> fprintf ppf "(Value_constptr %d)" p
| Value_float f -> fprintf ppf "(Value_float %.3f)" f
| Value_float_array value_float_array ->
fprintf ppf "(Value_float_array %a)"
match descr with
| Value_int i -> Format.pp_print_int ppf i
| Value_char c -> fprintf ppf "%c" c
- | Value_constptr i -> fprintf ppf "%ip" i
| Value_block (tag, fields) ->
fprintf ppf "[%a:%a]" Tag.print tag print_fields fields
| Value_mutable_block (tag, size) ->
| Value_mutable_block of Tag.t * int
| Value_int of int
| Value_char of char
- | Value_constptr of int
| Value_float of float
| Value_float_array of value_float_array
| Value_boxed_int : 'a A.boxed_int * 'a -> descr
match descr with
| Value_int _
| Value_char _
- | Value_constptr _
| Value_string _
| Value_float _
| Value_float_array _
type const =
| Int of int
| Char of char
- | Const_pointer of int
type apply = {
func : Variable.t;
match c with
| Int n -> fprintf ppf "%i" n
| Char c -> fprintf ppf "%C" c
- | Const_pointer n -> fprintf ppf "%ia" n
let print_function_declarations ppf (fd : function_declarations) =
let funs ppf =
match c1, c2 with
| Int i1, Int i2 -> compare i1 i2
| Char i1, Char i2 -> Char.compare i1 i2
- | Const_pointer i1, Const_pointer i2 -> compare i1 i2
- | Int _, (Char _ | Const_pointer _) -> -1
- | (Char _ | Const_pointer _), Int _ -> 1
- | Char _, Const_pointer _ -> -1
- | Const_pointer _, Char _ -> 1
+ | Int _, Char _ -> -1
+ | Char _, Int _ -> 1
let compare_constant_defining_value_block_field
(c1:constant_defining_value_block_field)
| Int of int
| Char of char
(** [Char] is kept separate from [Int] to improve printing *)
- | Const_pointer of int
- (** [Const_pointer] is an immediate value of a type whose values may be
- boxed (typically a variant type with both constant and non-constant
- constructors). *)
(** The application of a function to a list of arguments. *)
type apply = {
| Symbol symbol -> to_clambda_symbol' env symbol
| Const (Int i) -> Uconst_int i
| Const (Char c) -> Uconst_int (Char.code c)
- | Const (Const_pointer i) -> Uconst_ptr i
let rec to_clambda t env (flam : Flambda.t) : Clambda.ulambda =
match flam with
and to_clambda_named t env var (named : Flambda.named) : Clambda.ulambda =
match named with
| Symbol sym -> to_clambda_symbol env sym
- | Const (Const_pointer n) -> Uconst (Uconst_ptr n)
| Const (Int n) -> Uconst (Uconst_int n)
| Const (Char c) -> Uconst (Uconst_int (Char.code c))
| Allocated_const _ ->
Debuginfo.none)
in
match fields with
- | [] -> Uconst (Uconst_ptr 0)
+ | [] -> Uconst (Uconst_int 0)
| h :: t ->
List.fold_left (fun acc (p, field) ->
Clambda.Usequence (build_setfield (p, field), acc))
match const with
| Int i -> i
| Char c -> Char.code c
- | Const_pointer i -> i
in
Some (Clambda.Uconst_field_int n)
| Some (Flambda.Symbol sym) ->
let e2, constants, preallocated_blocks = loop env constants program in
Usequence (e1, e2), constants, preallocated_blocks
| End _ ->
- Uconst (Uconst_ptr 0), constants, []
+ Uconst (Uconst_int 0), constants, []
in
loop env constants program.program_body
| Value_unknown_descr -> A.value_unknown Other
| Value_int i -> A.value_int i
| Value_char c -> A.value_char c
- | Value_constptr i -> A.value_constptr i
| Value_float f -> A.value_float f
| Value_float_array float_array ->
begin match float_array.contents with
match const with
| Int i -> A.value_int i
| Char c -> A.value_char c
- | Const_pointer i -> A.value_constptr i
let approx_for_allocated_const (const : Allocated_const.t) =
match const with
[block_approx; _field_approx; value_approx] ->
if A.warn_on_mutation block_approx then begin
Location.prerr_warning (Debuginfo.to_location dbg)
- Warnings.Assignment_to_non_mutable_value
+ Warnings.Flambda_assignment_to_non_mutable_value
end;
let kind =
let check () =
| Psetfield _, _block::_, block_approx::_ ->
if A.warn_on_mutation block_approx then begin
Location.prerr_warning (Debuginfo.to_location dbg)
- Warnings.Assignment_to_non_mutable_value
+ Warnings.Flambda_assignment_to_non_mutable_value
end;
tree, ret r (A.value_unknown Other)
| (Psetfield _ | Parraysetu _ | Parraysets _), _, _ ->
if arg is not effectful we can also drop it. *)
simplify_free_variable env arg ~f:(fun env arg arg_approx ->
begin match arg_approx.descr with
- | Value_constptr 0 | Value_int 0 -> (* Constant [false]: keep [ifnot] *)
+ | Value_int 0 -> (* Constant [false]: keep [ifnot] *)
let ifnot, r = simplify env r ifnot in
ifnot, R.map_benefit r B.remove_branch
- | Value_constptr _ | Value_int _
+ | Value_int _
| Value_block _ -> (* Constant [true]: keep [ifso] *)
let ifso, r = simplify env r ifso in
ifso, R.map_benefit r B.remove_branch
in
let body =
List.fold_left (fun body param ->
- Flambda.create_let (Parameter.var param) (Const (Const_pointer 0)) body)
+ Flambda.create_let (Parameter.var param) (Const (Int 0)) body)
fun_decl.body
unused_params
in
| Value_block of Tag.t * t array
| Value_int of int
| Value_char of char
- | Value_constptr of int
| Value_float of float option
| Value_boxed_int : 'a boxed_int * 'a -> descr
| Value_set_of_closures of value_set_of_closures
let rec print_descr ppf = function
| Value_int i -> Format.pp_print_int ppf i
| Value_char c -> Format.fprintf ppf "%c" c
- | Value_constptr i -> Format.fprintf ppf "%ia" i
| Value_block (tag,fields) ->
let p ppf fields =
Array.iter (fun v -> Format.fprintf ppf "%a@ " print v) fields in
| Value_block _
| Value_int _
| Value_char _
- | Value_constptr _
| Value_boxed_int _
| Value_set_of_closures _
| Value_closure _
let value_unknown reason = approx (Value_unknown reason)
let value_int i = approx (Value_int i)
let value_char i = approx (Value_char i)
-let value_constptr i = approx (Value_constptr i)
let value_float f = approx (Value_float (Some f))
let value_any_float = approx (Value_float None)
let value_boxed_int bi i = approx (Value_boxed_int (bi,i))
let name = Internal_variable_names.const_char in
name_expr_fst (make_const_char_named n) ~name
-let make_const_ptr_named n : Flambda.named * t =
- Const (Const_pointer n), value_constptr n
-let make_const_ptr (n : int) =
- let name =
- match n with
- | 0 -> Internal_variable_names.const_ptr_zero
- | 1 -> Internal_variable_names.const_ptr_one
- | _ -> Internal_variable_names.const_ptr
- in
- name_expr_fst (make_const_ptr_named n) ~name
-
let make_const_bool_named b : Flambda.named * t =
- make_const_ptr_named (if b then 1 else 0)
+ make_const_int_named (if b then 1 else 0)
let make_const_bool b =
name_expr_fst (make_const_bool_named b)
~name:Internal_variable_names.const_bool
| Value_char n ->
let const, approx = make_const_char n in
const, Replaced_term, approx
- | Value_constptr n ->
- let const, approx = make_const_ptr n in
- const, Replaced_term, approx
| Value_float (Some f) ->
let const, approx = make_const_float f in
const, Replaced_term, approx
| Value_char n ->
let const, approx = make_const_char_named n in
const, Replaced_term, approx
- | Value_constptr n ->
- let const, approx = make_const_ptr_named n in
- const, Replaced_term, approx
| Value_float (Some f) ->
let const, approx = make_const_float_named f in
const, Replaced_term, approx
match t.descr with
| Value_int n -> Some (make_const_int_named n)
| Value_char n -> Some (make_const_char_named n)
- | Value_constptr n -> Some (make_const_ptr_named n)
| Value_float (Some f) -> Some (make_const_float_named f)
| Value_boxed_int (t, i) -> Some (make_const_boxed_int_named t i)
| Value_symbol sym -> Some (Symbol sym, t)
| Value_unknown _ -> false
| Value_string _ | Value_float_array _
| Value_bottom | Value_block _ | Value_int _ | Value_char _
- | Value_constptr _ | Value_set_of_closures _ | Value_closure _
+ | Value_set_of_closures _ | Value_closure _
| Value_extern _ | Value_float _ | Value_boxed_int _ | Value_symbol _ -> true
let useful t =
match t.descr with
| Value_unresolved _ | Value_unknown _ | Value_bottom -> false
| Value_string _ | Value_float_array _ | Value_block _ | Value_int _
- | Value_char _ | Value_constptr _ | Value_set_of_closures _
+ | Value_char _ | Value_set_of_closures _
| Value_float _ | Value_boxed_int _ | Value_closure _ | Value_extern _
| Value_symbol _ -> true
match t.descr with
| Value_block(_, fields) -> Array.length fields > 0
| Value_string { contents = Some _ }
- | Value_int _ | Value_char _ | Value_constptr _
+ | Value_int _ | Value_char _
| Value_set_of_closures _ | Value_float _ | Value_boxed_int _
| Value_closure _ -> true
| Value_string { contents = None } | Value_float_array _
(* CR-someday mshinwell: This should probably return Unreachable in more
cases. I added a couple more. *)
| Value_bottom
- | Value_int _ | Value_char _ | Value_constptr _ ->
+ | Value_int _ | Value_char _ ->
(* Something seriously wrong is happening: either the user is doing
something exceptionally unsafe, or it is an unreachable branch.
We consider this as unreachable and mark the result accordingly. *)
| Value_block (tag, fields) ->
Ok (tag, fields)
| Value_bottom
- | Value_int _ | Value_char _ | Value_constptr _
+ | Value_int _ | Value_char _
| Value_float_array _
| Value_string _ | Value_float _ | Value_boxed_int _
| Value_set_of_closures _ | Value_closure _
let rec meet_descr ~really_import_approx d1 d2 = match d1, d2 with
| Value_int i, Value_int j when i = j ->
d1
- | Value_constptr i, Value_constptr j when i = j ->
- d1
| Value_symbol s1, Value_symbol s2 when Symbol.equal s1 s2 ->
d1
| Value_extern e1, Value_extern e2 when Export_id.equal e1 e2 ->
to the set now out of scope. *)
Ok (t.var, value_set_of_closures)
| Value_closure _ | Value_block _ | Value_int _ | Value_char _
- | Value_constptr _ | Value_float _ | Value_boxed_int _ | Value_unknown _
+ | Value_float _ | Value_boxed_int _ | Value_unknown _
| Value_bottom | Value_extern _ | Value_string _ | Value_float_array _
| Value_symbol _ ->
Wrong
symbol, value_set_of_closures)
| Value_unresolved _
| Value_closure _ | Value_block _ | Value_int _ | Value_char _
- | Value_constptr _ | Value_float _ | Value_boxed_int _ | Value_unknown _
+ | Value_float _ | Value_boxed_int _ | Value_unknown _
| Value_bottom | Value_extern _ | Value_string _ | Value_float_array _
| Value_symbol _ ->
Wrong
Unknown_because_of_unresolved_value value
| Value_unresolved symbol -> Unresolved symbol
| Value_set_of_closures _ | Value_block _ | Value_int _ | Value_char _
- | Value_constptr _ | Value_float _ | Value_boxed_int _
+ | Value_float _ | Value_boxed_int _
| Value_bottom | Value_extern _ | Value_string _ | Value_float_array _
| Value_symbol _ ->
Wrong
| Value_unresolved _
| Value_unknown _ | Value_string _ | Value_float_array _
| Value_bottom | Value_block _ | Value_int _ | Value_char _
- | Value_constptr _ | Value_set_of_closures _ | Value_closure _
+ | Value_set_of_closures _ | Value_closure _
| Value_extern _ | Value_boxed_int _ | Value_symbol _ ->
None
(Value_float None | Value_unresolved _
| Value_unknown _ | Value_string _ | Value_float_array _
| Value_bottom | Value_block _ | Value_int _ | Value_char _
- | Value_constptr _ | Value_set_of_closures _ | Value_closure _
+ | Value_set_of_closures _ | Value_closure _
| Value_extern _ | Value_boxed_int _ | Value_symbol _)
-> None)
contents (Some [])
| Value_unresolved _
| Value_unknown _ | Value_float_array _
| Value_bottom | Value_block _ | Value_int _ | Value_char _
- | Value_constptr _ | Value_set_of_closures _ | Value_closure _
+ | Value_set_of_closures _ | Value_closure _
| Value_extern _ | Value_boxed_int _ | Value_symbol _ ->
None
(* In theory symbol cannot contain integers but this shouldn't
matter as this will always be an imported approximation *)
Can_be_taken
- | Value_constptr i | Value_int i when i = branch ->
+ | Value_int i when i = branch ->
Must_be_taken
| Value_char c when Char.code c = branch ->
Must_be_taken
- | Value_constptr _ | Value_int _ | Value_char _ ->
+ | Value_int _ | Value_char _ ->
Cannot_be_taken
| Value_block _ | Value_float _ | Value_float_array _
| Value_string _ | Value_closure _ | Value_set_of_closures _
| Value_extern _
| Value_symbol _) ->
Can_be_taken
- | (Value_constptr _ | Value_int _| Value_char _) ->
+ | (Value_int _| Value_char _) ->
Cannot_be_taken
| Value_block (block_tag, _) when Tag.to_int block_tag = tag ->
Must_be_taken
| Value_block of Tag.t * t array
| Value_int of int
| Value_char of char
- | Value_constptr of int
| Value_float of float option
| Value_boxed_int : 'a boxed_int * 'a -> descr
| Value_set_of_closures of value_set_of_closures
val value_immutable_float_array : t array -> t
val value_string : int -> string option -> t
val value_boxed_int : 'i boxed_int -> 'i -> t
-val value_constptr : int -> t
val value_block : Tag.t -> t array -> t
val value_extern : Export_id.t -> t
val value_symbol : Symbol.t -> t
together with an Flambda expression representing it. *)
val make_const_int : int -> Flambda.t * t
val make_const_char : char -> Flambda.t * t
-val make_const_ptr : int -> Flambda.t * t
val make_const_bool : bool -> Flambda.t * t
val make_const_float : float -> Flambda.t * t
val make_const_boxed_int : 'i boxed_int -> 'i -> Flambda.t * t
val make_const_int_named : int -> Flambda.named * t
val make_const_char_named : char -> Flambda.named * t
-val make_const_ptr_named : int -> Flambda.named * t
val make_const_bool_named : bool -> Flambda.named * t
val make_const_float_named : float -> Flambda.named * t
val make_const_boxed_int_named : 'i boxed_int -> 'i -> Flambda.named * t
let (new_expr, approx) = A.make_const_char_named c in
new_expr, approx, C.Benefit.remove_code_named expr C.Benefit.zero
else expr, A.value_char c, C.Benefit.zero
-let const_ptr_expr expr n =
- if Effect_analysis.no_effects_named expr then
- let (new_expr, approx) = A.make_const_ptr_named n in
- new_expr, approx, C.Benefit.remove_code_named expr C.Benefit.zero
- else expr, A.value_constptr n, C.Benefit.zero
let const_bool_expr expr b =
const_int_expr expr (if b then 1 else 0)
let const_float_expr expr f =
-> bool
-> Flambda.named * Simple_value_approx.t * Inlining_cost.Benefit.t
-val const_ptr_expr
- : Flambda.named
- -> int
- -> Flambda.named * Simple_value_approx.t * Inlining_cost.Benefit.t
-
val const_float_expr
: Flambda.named
-> float
let is_known_to_be_some_kind_of_int (arg:A.descr) =
match arg with
- | Value_int _ | Value_char _ | Value_constptr _ -> true
+ | Value_int _ | Value_char _ -> true
| Value_block (_, _) | Value_float _ | Value_set_of_closures _
| Value_closure _ | Value_string _ | Value_float_array _
| A.Value_boxed_int _ | Value_unknown _ | Value_extern _
match arg with
| Value_block _ | Value_float _ | Value_float_array _ | A.Value_boxed_int _
| Value_closure _ | Value_string _ -> true
- | Value_set_of_closures _ | Value_int _ | Value_char _ | Value_constptr _
+ | Value_set_of_closures _ | Value_int _ | Value_char _
| Value_unknown _ | Value_extern _ | Value_symbol _
| Value_unresolved _ | Value_bottom -> false
let rec structurally_different (arg1:A.t) (arg2:A.t) =
match arg1.descr, arg2.descr with
- | (Value_int n1 | Value_constptr n1), (Value_int n2 | Value_constptr n2)
+ | (Value_int n1), (Value_int n2)
when n1 <> n2 ->
true
| Value_block (tag1, fields1), Value_block (tag2, fields2) ->
| Pnot -> S.const_bool_expr expr (x = 0)
| Pnegint -> S.const_int_expr expr (-x)
| Pbswap16 -> S.const_int_expr expr (S.swap16 x)
+ | Pisint -> S.const_bool_expr expr true
| Poffsetint y -> S.const_int_expr expr (x + y)
| Pfloatofint when fpc -> S.const_float_expr expr (float_of_int x)
| Pbintofint Pnativeint ->
| Pbintofint Pint64 -> S.const_boxed_int_expr expr Int64 (Int64.of_int x)
| _ -> expr, A.value_unknown Other, C.Benefit.zero
end
- | [(Value_int x | Value_constptr x); (Value_int y | Value_constptr y)] ->
+ | [Value_int x; Value_int y] ->
let shift_precond = 0 <= y && y < 8 * size_int in
begin match p with
| Paddint -> S.const_int_expr expr (x + y)
| Pcompare_ints -> S.const_int_expr expr (Char.compare x y)
| _ -> expr, A.value_unknown Other, C.Benefit.zero
end
- | [Value_constptr x] ->
- begin match p with
- (* [Pidentity] should probably never appear, but is here for
- completeness. *)
- | Pnot -> S.const_bool_expr expr (x = 0)
- | Pisint -> S.const_bool_expr expr true
- | Poffsetint y -> S.const_ptr_expr expr (x + y)
- | _ -> expr, A.value_unknown Other, C.Benefit.zero
- end
| [Value_float (Some x)] when fpc ->
begin match p with
| Pintoffloat -> S.const_int_expr expr (int_of_float x)
when (is_pstring_length p || is_pbytes_length p) ->
S.const_int_expr expr size
| [Value_string { size; contents = Some s };
- (Value_int x | Value_constptr x)] when x >= 0 && x < size ->
+ (Value_int x)] when x >= 0 && x < size ->
begin match p with
| Pstringrefu
| Pstringrefs
| _ -> expr, A.value_unknown Other, C.Benefit.zero
end
| [Value_string { size; contents = None };
- (Value_int x | Value_constptr x)]
+ (Value_int x)]
when x >= 0 && x < size && is_pstringrefs p ->
Flambda.Prim (Pstringrefu, args, dbg),
A.value_unknown Other,
(* we improved it, but there is no way to account for that: *)
C.Benefit.zero
| [Value_string { size; contents = None };
- (Value_int x | Value_constptr x)]
+ (Value_int x)]
when x >= 0 && x < size && is_pbytesrefs p ->
Flambda.Prim (Pbytesrefu, args, dbg),
A.value_unknown Other,
fprintf ppf "%S=%a" s structured_constant c
| Uconst_ref (s, None) -> fprintf ppf "%S"s
| Uconst_int i -> fprintf ppf "%i" i
- | Uconst_ptr i -> fprintf ppf "%ia" i
and lam ppf = function
| Uvar id ->
opam-version: "2.0"
-version: "4.11.2"
-synopsis: "OCaml release 4.11.2"
+version: "4.12.0"
+synopsis: "OCaml 4.12.0"
depends: [
- "ocaml" {= "4.11.2" & post}
+ "ocaml" {= "4.12.0" & post}
"base-unix" {post}
"base-bigarray" {post}
"base-threads" {post}
odoc_config.cmi \
../driver/main_args.cmi \
../utils/config.cmi \
+ ../driver/compenv.cmi \
odoc_args.cmi
odoc_args.cmx : \
odoc_types.cmx \
odoc_config.cmx \
../driver/main_args.cmx \
../utils/config.cmx \
+ ../driver/compenv.cmx \
odoc_args.cmi
odoc_args.cmi : \
odoc_gen.cmi
ROOTDIR = ..
--include $(ROOTDIR)/Makefile.config
--include $(ROOTDIR)/Makefile.common
+include $(ROOTDIR)/Makefile.common
include $(ROOTDIR)/Makefile.best_binaries
-OCAMLRUN ?= $(ROOTDIR)/boot/ocamlrun
-OCAMLYACC ?= $(ROOTDIR)/yacc/ocamlyacc
+OCAMLRUN ?= $(ROOTDIR)/boot/ocamlrun$(EXE)
+OCAMLYACC ?= $(ROOTDIR)/yacc/ocamlyacc$(EXE)
STDLIBFLAGS = -nostdlib -I $(ROOTDIR)/stdlib
OCAMLC = $(BEST_OCAMLC) $(STDLIBFLAGS)
DEPFLAGS = -slash
OCAMLLEX = $(BEST_OCAMLLEX)
-# TODO: figure out whether the DEBUG lines the following preprocessor removes
-# are actually useful.
-# If they are not, then the preprocessor logic (including the
-# remove_DEBUG script and the debug target) could be removed.
-# If they are, it may be better to be able to enable them at run-time
-# rather than compile-time, e.g. through a -debug command-line option.
-# In the following line, "sh" is useful under Windows. Without it,
-# the ./remove_DEBUG command would be executed by cmd.exe which would not
-# know how to handle it.
-OCAMLPP=-pp 'sh ./remove_DEBUG'
-
# For installation
##############
-MKDIR=mkdir -p
CP=cp
-OCAMLDOC=ocamldoc
-OCAMLDOC_OPT=$(OCAMLDOC).opt
+OCAMLDOC=ocamldoc$(EXE)
+OCAMLDOC_OPT=ocamldoc.opt$(EXE)
+
+programs := ocamldoc ocamldoc.opt
# TODO: clarify whether the following really needs to be that complicated
ifeq "$(UNIX_OR_WIN32)" "unix"
.PHONY: generatorsopt
generatorsopt: $(GENERATORS_CMXS)
-# TODO: the following debug target could be replaced by a DEBUG variable
-.PHONY: debug
-debug:
- $(MAKE) OCAMLPP=""
-
OCAMLDOC_LIBRARIES = ocamlcommon unix str dynlink
OCAMLDOC_BCLIBRARIES = $(OCAMLDOC_LIBRARIES:%=%.cma)
OCAMLDOC_NCLIBRARIES = $(OCAMLDOC_LIBRARIES:%=%.cmxa)
+$(eval $(call PROGRAM_SYNONYM,ocamldoc))
+
$(OCAMLDOC): $(EXECMOFILES)
$(OCAMLC) -o $@ -linkall $(LINKFLAGS) $(OCAMLDOC_BCLIBRARIES) $^
+$(eval $(call PROGRAM_SYNONYM,ocamldoc.opt))
+
$(OCAMLDOC_OPT): $(EXECMXFILES)
$(OCAMLOPT_CMD) -o $@ -linkall $(LINKFLAGS) $(OCAMLDOC_NCLIBRARIES) $^
.SUFFIXES: .mll .mly .ml .mli .cmo .cmi .cmx .cmxs
.ml.cmo:
- $(OCAMLC) $(OCAMLPP) $(COMPFLAGS) -c $<
+ $(OCAMLC) $(COMPFLAGS) -c $<
.mli.cmi:
- $(OCAMLC) $(OCAMLPP) $(COMPFLAGS) -c $<
+ $(OCAMLC) $(COMPFLAGS) -c $<
.ml.cmx:
- $(OCAMLOPT) $(OCAMLPP) $(COMPFLAGS) -c $<
+ $(OCAMLOPT) $(COMPFLAGS) -c $<
.ml.cmxs:
- $(OCAMLOPT_CMD) -shared -o $@ $(OCAMLPP) $(COMPFLAGS) $<
+ $(OCAMLOPT_CMD) -shared -o $@ $(COMPFLAGS) $<
.mll.ml:
$(OCAMLLEX) $(OCAMLLEX_FLAGS) $<
$(MKDIR) "$(INSTALL_BINDIR)"
$(MKDIR) "$(INSTALL_LIBDIR)/ocamldoc"
$(MKDIR) "$(INSTALL_MANODIR)"
- $(INSTALL_PROG) $(OCAMLDOC) "$(INSTALL_BINDIR)/$(OCAMLDOC)$(EXE)"
+ $(INSTALL_PROG) $(OCAMLDOC) "$(INSTALL_BINDIR)"
$(INSTALL_DATA) \
ocamldoc.hva *.cmi $(OCAMLDOC_LIBCMA) \
"$(INSTALL_LIBDIR)/ocamldoc"
installopt_really:
$(MKDIR) "$(INSTALL_BINDIR)"
$(MKDIR) "$(INSTALL_LIBDIR)/ocamldoc"
- $(INSTALL_PROG) \
- $(OCAMLDOC_OPT) "$(INSTALL_BINDIR)/$(OCAMLDOC_OPT)$(EXE)"
+ $(INSTALL_PROG) $(OCAMLDOC_OPT) "$(INSTALL_BINDIR)"
$(INSTALL_DATA) \
$(OCAMLDOC_LIBCMIS) \
"$(INSTALL_LIBDIR)/ocamldoc"
.PHONY: clean
clean:
rm -f \#*\#
- rm -f $(OCAMLDOC) $(OCAMLDOC_OPT) *.cma *.cmxa *.cmo *.cmi *.cmx *.cmt *.cmti *.a *.lib *.o *.obj
+ rm -f $(programs) $(programs:=.exe)
+ rm -f *.cma *.cmxa *.cmo *.cmi *.cmx *.cmt *.cmti *.a *.lib *.o *.obj
rm -f odoc_parser.output odoc_text_parser.output
rm -f odoc_lexer.ml odoc_text_lexer.ml odoc_see_lexer.ml odoc_ocamlhtml.ml
rm -f odoc_parser.ml odoc_parser.mli odoc_text_parser.ml odoc_text_parser.mli
UNIX_MLIS = $(addprefix $(SRC)/otherlibs/unix/, unix.mli unixLabels.mli)
DYNLINK_MLIS = $(addprefix $(SRC)/otherlibs/dynlink/, dynlink.mli)
THREAD_MLIS = $(addprefix $(SRC)/otherlibs/systhreads/, \
- thread.mli condition.mli mutex.mli event.mli threadUnix.mli)
+ thread.mli condition.mli mutex.mli event.mli semaphore.mli threadUnix.mli)
DRIVER_MLIS = $(SRC)/driver/pparse.mli
module M = Odoc_messages
-let print_DEBUG s = print_string s ; print_newline ()
-
(* we check if we must load a module given on the command line *)
let arg_list = Array.to_list Sys.argv
let (plugins, paths) =
in
iter ([], []) arg_list
-let _ = print_DEBUG "Fin analyse des arguments pour le dynamic load"
-
(** Return the real name of the file to load,
searching it in the paths if it is
a simple name and not in the current directory. *)
;;
List.iter load_plugin plugins;;
-let () = print_DEBUG "Fin du chargement dynamique eventuel"
-
let () = Odoc_args.parse ()
(** Analysis of source files. This module is strongly inspired from
driver/main.ml :-) *)
-let print_DEBUG s = print_string s ; print_newline ()
-
open Format
open Typedtree
let parse () =
if modified_options () then append_last_doc "\n";
let options = !options @ !help_options in
- Arg.parse (Arg.align ~limit:13 options)
+ begin try
+ Arg.parse (Arg.align ~limit:13 options)
anonymous
- (M.usage^M.options_are);
+ (M.usage^M.options_are)
+ with Compenv.Exit_with_status n -> exit n
+ end;
(* we sort the hidden modules by name, to be sure that for example,
A.B is before A, so we will match against A.B before A in
Odoc_name.hide_modules.*)
open Types
open Typedtree
-let print_DEBUG3 s = print_string s ; print_newline ();;
-let print_DEBUG s = print_string s ; print_newline ();;
-
type typedtree = (Typedtree.structure * Typedtree.module_coercion)
open Odoc_parameter
in
(new_param, func_body2)
| _ ->
- print_DEBUG3 "Pas le bon filtre pour le parametre optionnel avec valeur par defaut.";
(parameter, func_body)
)
)
in
(new_param, body2)
| _ ->
- print_DEBUG3 "Pas le bon filtre pour le parametre optionnel avec valeur par defaut.";
(parameter, body)
)
)
(** Analysis of a parse tree structure with a typed tree, to return module elements.*)
let rec analyse_structure env current_module_name last_pos pos_limit parsetree typedtree =
- print_DEBUG "Odoc_ast:analyse_struture";
let (table, table_values) = Typedtree_search.tables typedtree.str_items in
let rec iter env last_pos = function
[] ->
(** Analysis of a parse tree structure item to obtain a new environment and a list of elements.*)
and analyse_structure_item env current_module_name loc pos_limit comment_opt parsetree_item_desc _typedtree
table table_values =
- print_DEBUG "Odoc_ast:analyse_struture_item";
match parsetree_item_desc with
Parsetree.Pstr_eval _ ->
(* don't care *)
| Parsetree.Pstr_primitive val_desc ->
let name_pre = val_desc.Parsetree.pval_name.txt in
(* of string * value_description *)
- print_DEBUG ("Parsetree.Pstr_primitive ("^name_pre^", ["^(String.concat ", " val_desc.Parsetree.pval_prim)^"]");
let typ = Typedtree_search.search_primitive table name_pre in
let name = Name.parens_if_infix name_pre in
let complete_name = Name.concat current_module_name name in
let loc_start = loc.Location.loc_start.Lexing.pos_cnum in
let loc_end = loc.Location.loc_end.Lexing.pos_cnum in
let mp_type_code = get_string_of_file loc_start loc_end in
- print_DEBUG (Printf.sprintf "mp_type_code=%s" mp_type_code);
let param =
{
mp_name ;
| (Parsetree.Pmod_constraint (p_module_expr2, p_modtype),
Typedtree.Tmod_constraint (tt_module_expr2, tt_modtype, _, _)) ->
- print_DEBUG ("Odoc_ast: case Parsetree.Pmod_constraint + Typedtree.Tmod_constraint "^module_name);
let m_base2 = analyse_module
env
current_module_name
tt_modtype, _, _)
) ->
(* needed for recursive modules *)
-
- print_DEBUG ("Odoc_ast: case Parsetree.Pmod_structure + Typedtree.Tmod_constraint "^module_name);
let elements = analyse_structure env complete_name pos_start pos_end p_structure tt_structure in
(* we must complete the included modules *)
let included_modules_from_tt = tt_get_included_module_list tt_structure in
| (Parsetree.Pmod_unpack p_exp,
Typedtree.Tmod_unpack (_t_exp, tt_modtype)) ->
- print_DEBUG ("Odoc_ast: case Parsetree.Pmod_unpack + Typedtree.Tmod_unpack "^module_name);
let code =
let loc = p_module_expr.Parsetree.pmod_loc in
let loc_end = loc.Location.loc_end.Lexing.pos_cnum in
}
| (_parsetree, _typedtree) ->
- (*DEBUG*)let s_parse =
- (*DEBUG*) match _parsetree with
- (*DEBUG*) Parsetree.Pmod_ident _ -> "Pmod_ident"
- (*DEBUG*) | Parsetree.Pmod_structure _ -> "Pmod_structure"
- (*DEBUG*) | Parsetree.Pmod_functor _ -> "Pmod_functor"
- (*DEBUG*) | Parsetree.Pmod_apply _ -> "Pmod_apply"
- (*DEBUG*) | Parsetree.Pmod_constraint _ -> "Pmod_constraint"
- (*DEBUG*) | Parsetree.Pmod_unpack _ -> "Pmod_unpack"
- (*DEBUG*) | Parsetree.Pmod_extension _ -> "Pmod_extension"
- (*DEBUG*)in
- (*DEBUG*)let s_typed =
- (*DEBUG*) match _typedtree with
- (*DEBUG*) Typedtree.Tmod_ident _ -> "Tmod_ident"
- (*DEBUG*) | Typedtree.Tmod_structure _ -> "Tmod_structure"
- (*DEBUG*) | Typedtree.Tmod_functor _ -> "Tmod_functor"
- (*DEBUG*) | Typedtree.Tmod_apply _ -> "Tmod_apply"
- (*DEBUG*) | Typedtree.Tmod_constraint _ -> "Tmod_constraint"
- (*DEBUG*) | Typedtree.Tmod_unpack _ -> "Tmod_unpack"
- (*DEBUG*)in
- (*DEBUG*)let code = get_string_of_file pos_start pos_end in
- print_DEBUG (Printf.sprintf "code=%s\ns_parse=%s\ns_typed=%s\n" code s_parse s_typed);
-
raise (Failure "analyse_module: parsetree and typedtree don't match.")
let analyse_typed_tree source_file input_file
open Odoc_types
-let print_DEBUG s = print_string s ; print_newline ();;
-
(** This variable contains the regular expression representing a blank but not a '\n'.*)
let simple_blank = "[ \013\009\012]"
None ->
()
| Some s ->
- (*DEBUG*)print_string ("remain: "^s); print_newline();
let lexbuf2 = Lexing.from_string s in
Odoc_parser.info_part2 Odoc_lexer.elements lexbuf2
end;
iter s
let all_special file s =
- print_DEBUG ("all_special: "^s);
let rec iter acc n s2 =
match retrieve_info_special file s2 with
(_, None) ->
(n, acc)
| (n2, Some i) ->
- print_DEBUG ("all_special: avant String.sub new_s="^s2);
- print_DEBUG ("n2="^(Int.to_string n2)) ;
- print_DEBUG ("len(s2)="^(Int.to_string (String.length s2))) ;
let new_s = String.sub s2 n2 ((String.length s2) - n2) in
- print_DEBUG ("all_special: apres String.sub new_s="^new_s);
iter (acc @ [i]) (n + n2) new_s
in
- let res = iter [] 0 s in
- print_DEBUG ("all_special: end");
- res
+ iter [] 0 s
let just_after_special file s =
- print_DEBUG ("just_after_special: "^s);
- let res = match retrieve_info_special file s with
+ match retrieve_info_special file s with
(_, None) ->
(0, None)
| (len, Some d) ->
)
| (_, Some _) ->
(0, None)
- in
- print_DEBUG ("just_after_special:end");
- res
let first_special file s =
retrieve_info_special file s
(** Environment for finding complete names from relative names. *)
-let print_DEBUG s = print_string s ; print_newline ();;
-
module Name = Odoc_name
(** relative name * complete name *)
let full_module_name env n =
try List.assoc n env.env_modules
- with Not_found ->
- print_DEBUG ("Module "^n^" not found with env=");
- List.iter (fun (sn, fn) -> print_DEBUG ("("^sn^", "^fn^")")) env.env_modules;
- n
+ with Not_found -> n
let full_module_type_name env n =
try List.assoc n env.env_module_types
- with Not_found ->
- print_DEBUG ("Module "^n^" not found with env=");
- List.iter (fun (sn, fn) -> print_DEBUG ("("^sn^", "^fn^")")) env.env_modules;
- n
+ with Not_found -> n
let full_module_or_module_type_name env n =
try List.assoc n env.env_modules
let full_extension_constructor_name env n =
try List.assoc n env.env_extensions
- with Not_found ->
- print_DEBUG ("Extension "^n^" not found with env=");
- List.iter (fun (sn, fn) -> print_DEBUG ("("^sn^", "^fn^")")) env.env_extensions;
- n
+ with Not_found -> n
let full_class_name env n =
try List.assoc n env.env_classes
- with Not_found ->
- print_DEBUG ("Class "^n^" not found with env=");
- List.iter (fun (sn, fn) -> print_DEBUG ("("^sn^", "^fn^")")) env.env_classes;
- n
+ with Not_found -> n
let full_class_type_name env n =
try List.assoc n env.env_class_types
- with Not_found ->
- print_DEBUG ("Class type "^n^" not found with env=");
- List.iter (fun (sn, fn) -> print_DEBUG ("("^sn^", "^fn^")")) env.env_class_types;
- n
+ with Not_found -> n
let full_class_or_class_type_name env n =
try List.assoc n env.env_classes
(** Generation of html documentation.*)
-let print_DEBUG s = print_string s ; print_newline ()
-
open Odoc_info
open Value
open Type
(** Print the html code for the [text_element] in parameter. *)
method html_of_text_element b txt =
- print_DEBUG "text::html_of_text_element";
match txt with
| Odoc_info.Raw s -> self#html_of_Raw b s
| Odoc_info.Code s -> self#html_of_Code b s
(** Print html code to display a [Types.type_expr list]. *)
method html_of_cstr_args ?par b m_name c_name sep l =
- print_DEBUG "html#html_of_cstr_args";
match l with
| Cstr_tuple l ->
- print_DEBUG "html#html_of_cstr_args: 1";
let s = Odoc_info.string_of_type_list ?par sep l in
let s2 = newline_to_indented_br s in
- print_DEBUG "html#html_of_cstr_args: 2";
bs b "<code class=\"type\">";
bs b (self#create_fully_qualified_idents_links m_name s2);
bs b "</code>"
| Cstr_record l ->
- print_DEBUG "html#html_of_cstr_args: 1 bis";
bs b "<code>";
self#html_of_record ~father:m_name ~close_env: "</code>"
(Naming.inline_recfield_target m_name c_name)
}
);
bs b ((self#keyword "class")^" ");
- print_DEBUG "html#html_of_class : virtual or not" ;
if c.cl_virtual then bs b ((self#keyword "virtual")^" ");
(
match c.cl_type_parameters with
self#html_of_class_type_param_expr_list b father l;
bs b " "
);
- print_DEBUG "html#html_of_class : with link or not" ;
(
if with_link then
bp b "<a href=\"%s\">%s</a>" html_file (Name.simple c.cl_name)
self#html_of_class_parameter_list b father c ;
self#html_of_class_kind b father ~cl: c c.cl_kind;
bs b "</pre>" ;
- print_DEBUG "html#html_of_class : info" ;
(
if complete then
self#html_of_info ~cls: "class top" ~indent: true
(** Generation of LaTeX documentation. *)
-let print_DEBUG s = print_string s ; print_newline ()
-
open Odoc_info
open Value
open Type
(** The nested comments level. *)
let comments_level = ref 0
-let print_DEBUG2 s = print_string s; print_newline ()
-
(** This function returns the given string without the leading and trailing blanks.*)
let remove_blanks s =
- print_DEBUG2 ("remove_blanks "^s);
let l = Str.split_delim (Str.regexp "\n") s in
let l2 =
let rec iter liste =
let h2 = Str.global_replace (Str.regexp ("^"^blank^"+")) "" h in
if h2 = "" then
(
- print_DEBUG2 (h^" n'a que des blancs");
(* we remove this line and must remove leading blanks of the next one *)
iter q
)
let h2 = Str.global_replace (Str.regexp (blank^"+$")) "" h in
if h2 = "" then
(
- print_DEBUG2 (h^" n'a que des blancs");
(* we remove this line and must remove trailing blanks of the next one *)
iter q
)
| [ '\010' ]
{ incr line_number;
incr Odoc_comments_global.nb_chars;
- print_DEBUG2 "newline";
elements lexbuf }
| "@"
{
let s = Lexing.lexeme lexbuf in
Odoc_comments_global.nb_chars := !Odoc_comments_global.nb_chars + (String.length s);
let s2 = String.sub s 1 ((String.length s) - 1) in
- print_DEBUG2 s2;
match s2 with
"param" ->
T_PARAM
let s = Lexing.lexeme lexbuf in
let s = Str.global_replace (Str.regexp_string "\\@") "@" s in
let s = remove_blanks s in
- print_DEBUG2 ("Desc "^s);
Desc s
}
| eof
(** Representation and manipulation of modules and module types. *)
-let print_DEBUG s = print_string s ; print_newline ()
-
module Name = Odoc_name
(** To keep the order of elements in a module. *)
*)
let rec module_elements visited ?(trans=true) m =
let rec iter_kind = function
- Module_struct l ->
- print_DEBUG "Odoc_module.module_elements: Module_struct";
- l
+ Module_struct l -> l
| Module_alias ma ->
- print_DEBUG "Odoc_module.module_elements: Module_alias";
if trans then
match ma.ma_module with
None -> []
else
[]
| Module_functor (_, k)
- | Module_apply (k, _) ->
- print_DEBUG "Odoc_module.module_elements: Module_functor ou Module_apply";
- iter_kind k
+ | Module_apply (k, _) -> iter_kind k
| Module_with (tk,_) ->
- print_DEBUG "Odoc_module.module_elements: Module_with";
module_type_elements ~trans: trans
{ mt_name = "" ; mt_info = None ; mt_type = None ;
mt_is_interface = false ; mt_file = "" ; mt_kind = Some tk ;
mt_loc = Odoc_types.dummy_loc ;
}
| Module_constraint (k, _tk) ->
- print_DEBUG "Odoc_module.module_elements: Module_constraint";
(* FIXME : use k or tk ? *)
module_elements visited ~trans: trans
{ m_name = "" ;
(** Representation and manipulation of method / function / class parameters. *)
-let print_DEBUG s = print_string s ; print_newline ()
-
(** Types *)
(** Representation of a simple parameter name *)
(** access to the optional description of a parameter name from an optional info structure.*)
let desc_from_info_opt info_opt s =
- print_DEBUG "desc_from_info_opt";
match info_opt with
None -> None
| Some i ->
try
Some (List.assoc s i.Odoc_types.i_params)
with
- Not_found ->
- print_DEBUG ("desc_from_info_opt "^s^" not found in\n");
- List.iter (fun (s, _) -> print_DEBUG s) i.Odoc_types.i_params;
- None
+ Not_found -> None
let identchar =
"[A-Za-z_\192-\214\216-\246\248-\255'0-9]"
let blank = "[ \010\013\009\012]"
-
-let print_DEBUG s = print_string s; print_newline ()
%}
%token <string * (string option)> Description
| _ :: [] ->
raise (Failure "usage: @param id description")
| id :: _ ->
- print_DEBUG ("Identificator "^id);
let reg = identchar^"+" in
- print_DEBUG ("reg="^reg);
if Str.string_match (Str.regexp reg) id 0 then
let remain = String.sub s (String.length id) ((String.length s) - (String.length id)) in
- print_DEBUG ("T_PARAM Desc remain="^remain);
let remain2 = Str.replace_first (Str.regexp ("^"^blank^"+")) "" remain in
params := !params @ [(id, remain2)]
else
| _ :: [] ->
raise (Failure "usage: @before version description")
| id :: _ ->
- print_DEBUG ("version "^id);
let remain = String.sub s (String.length id) ((String.length s) - (String.length id)) in
let remain2 = Str.replace_first (Str.regexp ("^"^blank^"+")) "" remain in
before := !before @ [(id, remain2)]
| _ :: [] ->
raise (Failure "usage: @raise Exception description")
| id :: _ ->
- print_DEBUG ("exception "^id);
let reg = uppercase^identchar^"*"^"\\(\\."^uppercase^identchar^"*\\)*" in
- print_DEBUG ("reg="^reg);
if Str.string_match (Str.regexp reg) id 0 then
let remain = String.sub s (String.length id) ((String.length s) - (String.length id)) in
let remain2 = Str.replace_first (Str.regexp ("^"^blank^"+")) "" remain in
(* *)
(**************************************************************************)
-let print_DEBUG2 s = print_string s ; print_newline ()
-
(** the lexer for special comments. *)
open Odoc_parser
rule main = parse
[' ' '\013' '\009' '\012'] +
{
- print_DEBUG2 "[' ' '\013' '\009' '\012'] +";
main lexbuf
}
| [ '\010' ]
{
- print_DEBUG2 " [ '\010' ] ";
main lexbuf
}
| "<"
{
- print_DEBUG2 "call url lexbuf" ;
url lexbuf
}
| "\""
{
- print_DEBUG2 "call doc lexbuf" ;
doc lexbuf
}
| '\''
{
- print_DEBUG2 "call file lexbuf" ;
file lexbuf
}
| eof
{
- print_DEBUG2 "EOF";
EOF
}
| ([^'>'] | '\n')+">"
{
let s = Lexing.lexeme lexbuf in
- print_DEBUG2 ("([^'>'] | '\n')+ \">\" with "^s) ;
See_url (String.sub s 0 ((String.length s) -1))
}
open Asttypes
open Types
-
-let print_DEBUG s = print_string s ; print_newline ();;
-
open Odoc_parameter
open Odoc_value
open Odoc_type
| Cstr_record l ->
Cstr_record (List.map (get_field env name_comment_list) l)
in
+ let vc_name = match constructor_name with
+ | "::" ->
+ (* The only infix constructor is always printed (::) *)
+ "(::)"
+ | s -> s
+ in
{
- vc_name = constructor_name ;
+ vc_name;
vc_args;
vc_ret = Option.map (Odoc_env.subst_type env) ret_type;
vc_text = comment_opt
pos_limit2
type_decl
in
-(* DEBUG *) begin
-(* DEBUG *) let comm =
-(* DEBUG *) match assoc_com with
-(* DEBUG *) | None -> "sans commentaire"
-(* DEBUG *) | Some c -> Odoc_misc.string_of_info c
-(* DEBUG *) in
-(* DEBUG *) print_DEBUG ("Type "^name.txt^" : "^comm);
-(* DEBUG *) let f_DEBUG (name, c_opt) =
-(* DEBUG *) let comm =
-(* DEBUG *) match c_opt with
-(* DEBUG *) | None -> "sans commentaire"
-(* DEBUG *) | Some c -> Odoc_misc.string_of_info c
-(* DEBUG *) in
-(* DEBUG *) print_DEBUG ("constructor/field "^name^": "^comm)
-(* DEBUG *) in
-(* DEBUG *) List.iter f_DEBUG name_comment_list;
-(* DEBUG *) end;
(* get the information for the type in the signature *)
let sig_type_decl =
try Signature_search.search_type table name.txt
pos_limit2
type_decl
in
-(* DEBUG *) begin
-(* DEBUG *) let comm =
-(* DEBUG *) match assoc_com with
-(* DEBUG *) | None -> "sans commentaire"
-(* DEBUG *) | Some c -> Odoc_misc.string_of_info c
-(* DEBUG *) in
-(* DEBUG *) print_DEBUG ("Type "^name.txt^" : "^comm);
-(* DEBUG *) let f_DEBUG (name, c_opt) =
-(* DEBUG *) let comm =
-(* DEBUG *) match c_opt with
-(* DEBUG *) | None -> "sans commentaire"
-(* DEBUG *) | Some c -> Odoc_misc.string_of_info c
-(* DEBUG *) in
-(* DEBUG *) print_DEBUG ("constructor/field "^name^": "^comm)
-(* DEBUG *) in
-(* DEBUG *) List.iter f_DEBUG name_comment_list;
-(* DEBUG *) end;
(* get the information for the type in the signature *)
let sig_type_decl =
try Signature_search.search_type table name.txt
(* FIXME : can this be a Tmty_ident? in this case, we wouldn't have the signature *)
Types.Mty_signature s ->
Odoc_env.add_signature e complete_name ~rel: name s
- | _ ->
- print_DEBUG "not a Tmty_signature";
- e
+ | _ -> e
)
env
decls
let loc_start = Loc.start loc in
let loc_end = Loc.end_ loc in
let mp_type_code = get_string_of_file loc_start loc_end in
- print_DEBUG (Printf.sprintf "mp_type_code=%s" mp_type_code);
match sig_module_type with
Types.Mty_functor (param, body_module_type) ->
let mp_name, mp_kind =
let loc_start = Loc.start loc in
let loc_end = Loc.end_ loc in
let mp_type_code = get_string_of_file loc_start loc_end in
- print_DEBUG (Printf.sprintf "mp_type_code=%s" mp_type_code);
let mp_name, mp_kind =
match param2, param with
Parsetree.Named (_, pmty), Types.Named (Some ident, mty) ->
match parse_class_type.Parsetree.pcty_desc, sig_class_type with
(Parsetree.Pcty_constr (_, _) (*of Longident.t * core_type list *),
Types.Cty_constr (p, typ_list, _) (*of Path.t * type_expr list * class_type*)) ->
- print_DEBUG "Cty_constr _";
let path_name = Name.from_path p in
let name = Odoc_env.full_class_or_class_type_name env path_name in
let k =
match parse_class_type.Parsetree.pcty_desc, sig_class_type with
(Parsetree.Pcty_constr (_, _) (*of Longident.t * core_type list *),
Types.Cty_constr (p, typ_list, _) (*of Path.t * type_expr list * class_type*)) ->
- print_DEBUG "Cty_constr _";
Class_type
{
cta_name = Odoc_env.full_class_or_class_type_name env (Name.from_path p) ;
let blank = "[ \013\009\012]"
-
-let print_DEBUG s = print_string s; print_newline ()
-
(** this flag indicates whether we're in a string between begin_code and end_code tokens, to
remember the number of open '[' and handle ']' correctly. *)
let open_brackets = ref 0
| end
{
- print_DEBUG "end";
incr_cpts lexbuf ;
if !verb_mode || !target_mode || !code_pre_mode ||
(!open_brackets >= 1) then
}
| begin_title
{
- print_DEBUG "begin_title";
incr_cpts lexbuf ;
if !verb_mode || !target_mode || !code_pre_mode ||
(!open_brackets >= 1) || !ele_ref_mode then
}
| begin_list
{
- print_DEBUG "LIST";
incr_cpts lexbuf ;
if !verb_mode || !target_mode || !code_pre_mode ||
(!open_brackets >= 1) || !ele_ref_mode then
}
| begin_item
{
- print_DEBUG "ITEM";
incr_cpts lexbuf ;
if !verb_mode || !target_mode || !code_pre_mode ||
(!open_brackets >= 1) || !ele_ref_mode then
| begin_custom
{
- print_DEBUG "begin_custom";
incr_cpts lexbuf ;
if !verb_mode || !target_mode || !code_pre_mode ||
(!open_brackets >= 1) || !ele_ref_mode then
let remove_trailing_blanks s =
Str.global_replace (Str.regexp (blank^"+$")) "" s
-
-let print_DEBUG s = print_string s; print_newline ()
%}
%token END
+++ /dev/null
-#!/bin/sh
-
-#**************************************************************************
-#* *
-#* OCaml *
-#* *
-#* Damien Doligez, projet Moscova, INRIA Rocquencourt *
-#* *
-#* Copyright 2003 Institut National de Recherche en Informatique et *
-#* en Automatique. *
-#* *
-#* All rights reserved. This file is distributed under the terms of *
-#* the GNU Lesser General Public License version 2.1, with the *
-#* special exception on linking described in the file LICENSE. *
-#* *
-#**************************************************************************
-
-# usage: remove_DEBUG <file>
-# remove from <file> every line that contains the string "DEBUG",
-# respecting the cpp # line annotation conventions
-
-echo "# 1 \"$1\""
-LC_ALL=C sed -e '/DEBUG/s/^.*$/(* DEBUG statement removed *)/' "$1"
-run_unix.$(O): run_unix.c run.h ../runtime/caml/misc.h \
- ../runtime/caml/config.h ../runtime/caml/m.h ../runtime/caml/s.h \
- run_common.h
-run_stubs.$(O): run_stubs.c run.h ../runtime/caml/misc.h \
- ../runtime/caml/config.h ../runtime/caml/m.h ../runtime/caml/s.h \
- ../runtime/caml/mlvalues.h ../runtime/caml/misc.h \
- ../runtime/caml/domain_state.h ../runtime/caml/mlvalues.h \
- ../runtime/caml/domain_state.tbl ../runtime/caml/memory.h \
- ../runtime/caml/gc.h ../runtime/caml/major_gc.h \
- ../runtime/caml/freelist.h ../runtime/caml/minor_gc.h \
- ../runtime/caml/address_class.h ../runtime/caml/domain.h \
- ../runtime/caml/io.h ../runtime/caml/osdeps.h ../runtime/caml/memory.h
-ocamltest_stdlib_stubs.$(O): ocamltest_stdlib_stubs.c \
- ../runtime/caml/config.h ../runtime/caml/m.h ../runtime/caml/s.h \
- ../runtime/caml/mlvalues.h ../runtime/caml/config.h \
- ../runtime/caml/misc.h ../runtime/caml/domain_state.h \
- ../runtime/caml/mlvalues.h ../runtime/caml/domain_state.tbl \
- ../runtime/caml/memory.h ../runtime/caml/gc.h ../runtime/caml/major_gc.h \
- ../runtime/caml/freelist.h ../runtime/caml/minor_gc.h \
- ../runtime/caml/address_class.h ../runtime/caml/domain.h \
- ../runtime/caml/alloc.h ../runtime/caml/signals.h \
- ../runtime/caml/osdeps.h ../runtime/caml/memory.h
actions.cmo : \
variables.cmi \
result.cmi \
ocaml_files.cmo : \
ocamltest_stdlib.cmi \
ocamltest_config.cmi \
+ ocaml_directories.cmi \
ocaml_files.cmi
ocaml_files.cmx : \
ocamltest_stdlib.cmx \
ocamltest_config.cmx \
+ ocaml_directories.cmx \
ocaml_files.cmi
ocaml_files.cmi :
ocaml_filetypes.cmo : \
ocamltest_config.cmi
ocamltest_config.cmi :
ocamltest_stdlib.cmo : \
+ ocamltest_unix.cmi \
+ ocamltest_config.cmi \
ocamltest_stdlib.cmi
ocamltest_stdlib.cmx : \
+ ocamltest_unix.cmx \
+ ocamltest_config.cmx \
ocamltest_stdlib.cmi
-ocamltest_stdlib.cmi :
+ocamltest_stdlib.cmi : \
+ ocamltest_unix.cmi
+ocamltest_unix.cmo : \
+ ocamltest_unix.cmi
+ocamltest_unix.cmx : \
+ ocamltest_unix.cmi
+ocamltest_unix.cmi :
options.cmo : \
variables.cmi \
tests.cmi \
ROOTDIR = ..
--include $(ROOTDIR)/Makefile.config
--include $(ROOTDIR)/Makefile.common
+include $(ROOTDIR)/Makefile.common
include $(ROOTDIR)/Makefile.best_binaries
ifeq "$(filter str,$(OTHERLIBRARIES))" ""
endif
ifeq "$(filter $(UNIXLIB),$(OTHERLIBRARIES))" ""
+ ocamltest_unix := dummy
+ unix_name :=
+ unix_path :=
unix := None
+ unix_include :=
else
+ ocamltest_unix := real
+ unix_name := unix
+ unix_path := $(ROOTDIR)/otherlibs/$(UNIXLIB)
+ unix_include := -I $(unix_path) $(EMPTY)
ifeq "$(UNIX_OR_WIN32)" "win32"
unix := Some false
else
endif
ifeq "$(UNIX_OR_WIN32)" "win32"
- ocamlsrcdir := $(shell echo "$(abspath $(shell pwd)/..)"|cygpath -w -f - \
- | sed 's/\\/\\\\\\\\/g')
- mkexe := $(MKEXE_ANSI) -link $(OC_LDFLAGS)
+ ocamlsrcdir := $(shell echo "$(abspath $(shell pwd)/..)" | cygpath -w -f -)
else
ocamlsrcdir := $(abspath $(shell pwd)/..)
- mkexe := $(MKEXE)
endif
+mkexe := $(MKEXE)
ifeq "$(TOOLCHAIN)" "msvc"
CPP := $(CPP) 2> nul
OC_CPPFLAGS += -I$(ROOTDIR)/runtime -DCAML_INTERNALS
-run := run_$(UNIX_OR_WIN32)
+ifdef UNIX_OR_WIN32
+run_source := run_$(UNIX_OR_WIN32).c
+else
+ifneq "$(filter-out $(CLEAN_TARGET_NAMES), $(MAKECMDGOALS))" ""
+$(warning The variable UNIX_OR_WIN32 is not defined. \
+ It must be set (usually by $(ROOTDIR)/configure), \
+ or only clean rules are supported.)
+endif
+# If we are in a 'clean' rule, we ask for both versions to be cleaned.
+run_source := run_unix.c run_win32.c
+endif
# List of source files from which ocamltest is compiled
# (all the different sorts of files are derived from this)
# which is actually built into the tool but clearly separated from its core
core := \
- $(run).c \
- run_stubs.c \
- ocamltest_stdlib_stubs.c \
+ $(run_source) run_stubs.c \
ocamltest_config.mli ocamltest_config.ml.in \
+ ocamltest_unix.mli ocamltest_unix.ml \
ocamltest_stdlib.mli ocamltest_stdlib.ml \
run_command.mli run_command.ml \
filecompare.mli filecompare.ml \
config_files := $(filter %.ml.in,$(sources))
dependencies_generated_prereqs := \
+ ocamltest_unix.ml \
$(config_files:.ml.in=.ml) \
$(lexers:.mll=.ml) \
$(parsers:.mly=.mli) $(parsers:.mly=.ml)
-strict-sequence -safe-string -strict-formats \
-w +a-4-9-41-42-44-45-48 -warn-error A
-ocamlc := $(BEST_OCAMLC) $(flags)
+ocamlc = $(BEST_OCAMLC) $(flags)
-ocamlopt := $(BEST_OCAMLOPT) $(flags)
+ocamlopt = $(BEST_OCAMLOPT) $(flags)
ocamldep := $(BEST_OCAMLDEP)
depflags := -slash
ocamllex := $(BEST_OCAMLLEX)
-ocamlyacc := $(ROOTDIR)/yacc/ocamlyacc
+ocamlyacc := $(ROOTDIR)/yacc/ocamlyacc$(EXE)
ocamlcdefaultflags :=
compdeps_names=ocamlcommon ocamlbytecomp
compdeps_paths=$(addprefix $(ROOTDIR)/compilerlibs/,$(compdeps_names))
-compdeps_byte=$(addsuffix .cma,$(compdeps_paths))
-compdeps_opt=$(addsuffix .cmxa,$(compdeps_paths))
+deps_paths=$(compdeps_paths) $(addprefix $(unix_path)/,$(unix_name))
+deps_byte=$(addsuffix .cma,$(deps_paths))
+deps_opt=$(addsuffix .cmxa,$(deps_paths))
-ocamltest$(EXE): $(compdeps_byte) $(bytecode_modules)
- $(ocamlc_cmd) -custom -o $@ $^
+$(eval $(call PROGRAM_SYNONYM,ocamltest))
-%.cmo: %.ml $(compdeps_byte)
+ocamltest_unix.%: flags+=$(unix_include) -opaque
+
+ocamltest$(EXE): $(deps_byte) $(bytecode_modules)
+ $(ocamlc_cmd) $(unix_include)-custom -o $@ $^
+
+%.cmo: %.ml $(deps_byte)
$(ocamlc) -c $<
-ocamltest.opt$(EXE): $(compdeps_opt) $(native_modules)
- $(ocamlopt_cmd) -o $@ $^
+$(eval $(call PROGRAM_SYNONYM,ocamltest.opt))
+
+ocamltest.opt$(EXE): $(deps_opt) $(native_modules)
+ $(ocamlopt_cmd) $(unix_include)-o $@ $^
-%.cmx: %.ml $(compdeps_opt)
+%.cmx: %.ml $(deps_opt)
$(ocamlopt) -c $<
-%.cmi: %.mli $(compdeps_byte)
+%.cmi: %.mli $(deps_byte)
$(ocamlc) -c $<
%.ml %.mli: %.mly
%.ml: %.mll
$(ocamllex) $(OCAMLLEX_FLAGS) $<
+ocamltest_unix.ml: ocamltest_unix_$(ocamltest_unix).ml
+ echo '# 1 "$^"' > $@
+ cat $^ >> $@
+
ocamltest_config.ml: ocamltest_config.ml.in Makefile ../Makefile.config
- sed \
- -e 's|@@AFL_INSTRUMENT@@|$(AFL_INSTRUMENT)|' \
- -e 's|@@RUNTIMEI@@|$(RUNTIMEI)|' \
- -e 's|@@ARCH@@|$(ARCH)|' \
- -e 's|@@SHARED_LIBRARIES@@|$(SUPPORTS_SHARED_LIBRARIES)|' \
- -e 's|@@UNIX@@|$(unix)|' \
- -e 's|@@SYSTHREADS@@|$(systhreads)|' \
- -e 's|@@STR@@|$(str)|' \
- -e 's|@@SYSTEM@@|$(SYSTEM)|' \
- -e 's|@@CPP@@|$(CPP)|' \
- -e 's|@@OCAMLCDEFAULTFLAGS@@|$(ocamlcdefaultflags)|' \
- -e 's|@@OCAMLOPTDEFAULTFLAGS@@|$(ocamloptdefaultflags)|' \
- -e 's|@@OCAMLSRCDIR@@|$(ocamlsrcdir)|' \
- -e 's|@@FLAMBDA@@|$(FLAMBDA)|' \
- -e 's|@@SPACETIME@@|$(WITH_SPACETIME)|' \
- -e 's|@@FORCE_SAFE_STRING@@|$(FORCE_SAFE_STRING)|' \
- -e 's|@@FLAT_FLOAT_ARRAY@@|$(FLAT_FLOAT_ARRAY)|' \
- -e 's|@@OCAMLDOC@@|$(WITH_OCAMLDOC)|' \
- -e 's|@@OCAMLDEBUG@@|$(WITH_OCAMLDEBUG)|' \
- -e 's|@@OBJEXT@@|$(O)|' \
- -e 's|@@ASMEXT@@|$(S)|' \
- -e 's|@@NATIVE_DYNLINK@@|$(NATDYNLINK)|' \
- -e 's|@@SHARED_LIBRARY_CFLAGS@@|$(SHAREDLIB_CFLAGS)|' \
- -e 's|@@SHAREDOBJEXT@@|$(SO)|' \
- -e 's|@@CSC@@|$(CSC)|' \
- -e 's|@@CSCFLAGS@@|$(CSCFLAGS)|' \
- -e 's|@@MKDLL@@|$(MKDLL)|' \
- -e 's|@@MKEXE@@|$(mkexe)|' \
- -e 's|@@BYTECCLIBS@@|$(BYTECCLIBS)|' \
- -e 's|@@NATIVECCLIBS@@|$(NATIVECCLIBS)|' \
- -e 's|@@ASM@@|$(ASM)|' \
- -e 's|@@CC@@|$(CC)|' \
- -e 's|@@CFLAGS@@|$(OC_CFLAGS)|' \
- -e 's|@@CCOMPTYPE@@|$(CCOMPTYPE)|' \
- -e 's|@@WINDOWS_UNICODE@@|$(WINDOWS_UNICODE)|' \
- -e 's|@@FUNCTION_SECTIONS@@|$(FUNCTION_SECTIONS)|' \
- $< > $@
+ sed $(call SUBST,AFL_INSTRUMENT) \
+ $(call SUBST,RUNTIMEI) \
+ $(call SUBST,ARCH) \
+ $(call SUBST,SUPPORTS_SHARED_LIBRARIES) \
+ $(call SUBST,unix) \
+ $(call SUBST,systhreads) \
+ $(call SUBST,str) \
+ $(call SUBST,SYSTEM) \
+ $(call SUBST_STRING,CPP) \
+ $(call SUBST_STRING,ocamlcdefaultflags) \
+ $(call SUBST_STRING,ocamloptdefaultflags) \
+ $(call SUBST_STRING,ocamlsrcdir) \
+ $(call SUBST,FLAMBDA) \
+ $(call SUBST,FORCE_SAFE_STRING) \
+ $(call SUBST,FLAT_FLOAT_ARRAY) \
+ $(call SUBST,WITH_OCAMLDOC) \
+ $(call SUBST,WITH_OCAMLDEBUG) \
+ $(call SUBST,O) \
+ $(call SUBST,S) \
+ $(call SUBST,NATIVE_COMPILER) \
+ $(call SUBST,NATDYNLINK) \
+ $(call SUBST_STRING,SHAREDLIB_CFLAGS) \
+ $(call SUBST,SO) \
+ $(call SUBST_STRING,CSC) \
+ $(call SUBST_STRING,CSCFLAGS) \
+ $(call SUBST_STRING,EXE) \
+ $(call SUBST_STRING,MKDLL) \
+ $(call SUBST_STRING,mkexe) \
+ $(call SUBST_STRING,BYTECCLIBS) \
+ $(call SUBST_STRING,NATIVECCLIBS) \
+ $(call SUBST_STRING,ASM) \
+ $(call SUBST_STRING,CC) \
+ $(call SUBST_STRING,OC_CFLAGS) \
+ $(call SUBST,CCOMPTYPE) \
+ $(call SUBST,WINDOWS_UNICODE) \
+ $(call SUBST,FUNCTION_SECTIONS) \
+ $(call SUBST,NAKED_POINTERS) \
+ $< > $@
# Manual
clean:
rm -rf ocamltest ocamltest.exe ocamltest.opt ocamltest.opt.exe
rm -rf $(c_files:.c=.o) $(c_files:.c=.obj)
- rm -rf run_unix.o run_win32.o run_win32.obj
rm -rf $(ml_files:.ml=.o) $(ml_files:.ml=.obj)
rm -rf $(cmi_files)
rm -rf $(cmo_files)
rm -rf $(cmx_files)
rm -rf $(generated)
rm -f ocamltest.html
+ rm -rf $(DEPDIR)
+
+ifeq "$(COMPUTE_DEPS)" "true"
+include $(addprefix $(DEPDIR)/, $(c_files:.c=.$(D)))
+endif
+
+$(DEPDIR)/%.$(D): %.c | $(DEPDIR)
+ $(DEP_CC) $(OC_CPPFLAGS) $(CPPFLAGS) $< -MT '$*.$(O)' -MF $@
-ifneq "$(TOOLCHAIN)" "msvc"
.PHONY: depend
depend: $(dependencies_generated_prereqs)
- $(CC) -MM $(OC_CPPFLAGS) $(c_files) \
- | sed -e 's/\.o/.$$(O)/' > .depend
$(ocamldep) $(depflags) $(depincludes) $(mli_files) $(ml_files) \
- >> .depend
-endif
+ > .depend
-include .depend
let setup_symlinks test_source_directory build_directory files =
let symlink filename =
+ (* Emulate ln -sfT *)
let src = Filename.concat test_source_directory filename in
- let cmd = "ln -sf " ^ src ^" " ^ build_directory in
- Sys.run_system_command cmd in
+ let dst = Filename.concat build_directory filename in
+ let () =
+ if Sys.file_exists dst then
+ if Sys.win32 && Sys.is_directory dst then
+ (* Native symbolic links to directories don't disappear with unlink;
+ doing rmdir here is technically slightly more than ln -sfT would
+ do *)
+ Sys.rmdir dst
+ else
+ Sys.remove dst
+ in
+ Unix.symlink src dst in
let copy filename =
let src = Filename.concat test_source_directory filename in
let dst = Filename.concat build_directory filename in
Sys.copy_file src dst in
- let f = if Sys.os_type="Win32" then copy else symlink in
+ let f = if Unix.has_symlink () then symlink else copy in
Sys.make_directory build_directory;
List.iter f files
in
let lst = List.concat (List.map String.words cmd) in
let quoted_lst =
- if Sys.os_type="Win32"
+ if Sys.win32
then List.map Filename.maybe_quote lst
else lst in
let cmd' = String.concat " " quoted_lst in
environment
(Environments.to_system_env env)
in
- Run_command.run {
- Run_command.progname = progname;
- Run_command.argv = arguments;
- Run_command.envp = systemenv;
- Run_command.stdin_filename = stdin_filename;
- Run_command.stdout_filename = stdout_filename;
- Run_command.stderr_filename = stderr_filename;
- Run_command.append = append;
- Run_command.timeout = timeout;
- Run_command.log = log
- }
+ let n =
+ Run_command.run {
+ Run_command.progname = progname;
+ Run_command.argv = arguments;
+ Run_command.envp = systemenv;
+ Run_command.stdin_filename = stdin_filename;
+ Run_command.stdout_filename = stdout_filename;
+ Run_command.stderr_filename = stderr_filename;
+ Run_command.append = append;
+ Run_command.timeout = timeout;
+ Run_command.log = log
+ }
+ in
+ let dump_file s fn =
+ if not (Sys.file_is_empty fn) then begin
+ Printf.fprintf log "### begin %s ###\n" s;
+ Sys.dump_file log fn;
+ Printf.fprintf log "### end %s ###\n" s
+ end
+ in
+ dump_file "stdout" stdout_filename;
+ if stdout_filename <> stderr_filename then dump_file "stderr" stderr_filename;
+ n
let run
(log_message : string)
"Target supports function sections"
"Target does not support function sections")
+let naked_pointers = make
+ "naked_pointers"
+ (Actions_helpers.pass_or_skip (Ocamltest_config.naked_pointers)
+ "Runtime system supports naked pointers"
+ "Runtime system does not support naked pointers")
+
let has_symlink = make
"has_symlink"
- (Actions_helpers.pass_or_skip (Sys.has_symlink () )
+ (Actions_helpers.pass_or_skip (Unix.has_symlink () )
"symlinks available"
"symlinks not available")
] env
let _ =
- Environments.register_initializer
+ Environments.register_initializer Environments.Post
"test_exit_status_variables" initialize_test_exit_status_variables;
List.iter register
[
arch_i386;
arch_power;
function_sections;
+ naked_pointers
]
(rule
(targets ocamltest_config.ml)
- (deps ../Makefile.config ../Makefile.common ../Makefile.best_binaries Makefile
- ./ocamltest_config.ml.in ./getocamloptdefaultflags)
- (action (run make %{targets})))
+ (deps
+ ../Makefile.config
+ ../Makefile.build_config
+ ../Makefile.config_if_required
+ ../Makefile.common
+ ../Makefile.best_binaries
+ Makefile
+ ./ocamltest_config.ml.in
+ ./getocamloptdefaultflags)
+ (action (run make %{targets} COMPUTE_DEPS=false)))
;; FIXME: handle UNIX_OR_WIN32 or something similar
(library
(modes byte)
(wrapped false)
(flags (:standard -nostdlib))
- (libraries ocamlcommon stdlib)
+ (libraries ocamlcommon stdlib
+ (select ocamltest_unix.ml from
+ (unix -> ocamltest_unix_real.ml)
+ (-> ocamltest_unix_dummy.ml)))
(modules (:standard \ options main))
(c_flags (-DCAML_INTERNALS -I%{project_root}/runtime)) ; fixme
- (c_names run_unix run_stubs ocamltest_stdlib_stubs))
+ (c_names run_unix run_stubs))
(rule
(targets empty.ml)
(* Initializers *)
+type kind = Pre | Post
+
type env_initializer = out_channel -> t -> t
-let (initializers : (string, env_initializer) Hashtbl.t) = Hashtbl.create 10
+type initializers =
+ {
+ pre: (string, env_initializer) Hashtbl.t;
+ post: (string, env_initializer) Hashtbl.t;
+ }
+
+let initializers = {pre = Hashtbl.create 10; post = Hashtbl.create 10}
+
+let get_initializers = function
+ | Pre -> initializers.pre
+ | Post -> initializers.post
-let register_initializer name code = Hashtbl.add initializers name code
+let register_initializer kind name code =
+ Hashtbl.add (get_initializers kind) name code
let apply_initializer _log _name code env =
code _log env
-let initialize log env =
+let initialize kind log env =
let f = apply_initializer log in
- Hashtbl.fold f initializers env
+ Hashtbl.fold f (get_initializers kind) env
(* Modifiers *)
(* Initializers *)
+type kind = Pre | Post
+
type env_initializer = out_channel -> t -> t
-val register_initializer : string -> env_initializer -> unit
+val register_initializer : kind -> string -> env_initializer -> unit
-val initialize : env_initializer
+val initialize : kind -> env_initializer
(* Modifiers *)
output_filename : string;
}
-let read_text_file lines_to_drop fn =
- let ic = open_in_bin fn in
- let drop_cr s =
- let l = String.length s in
- if l > 0 && s.[l - 1] = '\r' then String.sub s 0 (l - 1)
- else raise Exit
- in
- let rec drop k =
- if k = 0 then
- loop []
+let last_is_cr s =
+ let l = String.length s in
+ l > 0 && s.[l - 1] = '\r'
+
+(* Returns last character of an input file. Fails for an empty file. *)
+let last_char ic =
+ seek_in ic (in_channel_length ic - 1);
+ input_char ic
+
+(* [line_seq_of_in_channel ~normalise ic first_line] constructs a sequence of
+ the lines of [ic] where [first_line] is the already read first line of [ic].
+ Strings include the line terminator and CRLF is normalised to LF if
+ [normalise] is [true]. The sequence raises [Exit] if normalise is [true] and
+ a terminated line is encountered which does not end CRLF. The final line of
+ the sequence only includes a terminator if it is present in the file (and a
+ terminating CR is never normalised if not strictly followed by LF). *)
+let line_seq_of_in_channel ~normalise ic =
+ let normalise =
+ if normalise then
+ fun s ->
+ if last_is_cr s then
+ String.sub s 0 (String.length s - 1)
+ else
+ raise Exit
else
- let stop = try ignore (input_line ic); false with End_of_file -> true in
- if stop then [] else drop (k-1)
- and loop acc =
- match input_line ic with
- | s -> loop (s :: acc)
- | exception End_of_file ->
- close_in ic;
- try List.rev_map drop_cr acc
- with Exit -> List.rev acc
+ Fun.id
in
- drop lines_to_drop
+ let rec read_line last () =
+ (* Read the next line to determine if the last line ended with LF *)
+ match input_line ic with
+ | line ->
+ Seq.Cons (normalise last ^ "\n", read_line line)
+ | exception End_of_file ->
+ (* EOF reached - seek the last character to determine if the final
+ line ends in LF *)
+ let last =
+ if last_char ic = '\n' then
+ normalise last ^ "\n"
+ else
+ last
+ in
+ Seq.Cons (last, Seq.empty)
+ in
+ read_line
-let compare_text_files dropped_lines file1 file2 =
- if read_text_file 0 file1 = read_text_file dropped_lines file2 then
- Same
- else
- Different
+let compare_text_files ignored_lines file1 file2 =
+ Sys.with_input_file ~bin:true file2 @@ fun ic2 ->
+ (* Get the first non-dropped line of file2 and determine if could be
+ CRLF-normalised (it can't be in any of the dropped lines didn't end
+ CRLF. *)
+ let (crlf_endings2, line2, reached_end_file2) =
+ let rec loop crlf_endings2 k =
+ match input_line ic2 with
+ | line ->
+ let crlf_endings2 = crlf_endings2 && last_is_cr line in
+ if k = 0 then
+ (crlf_endings2, line, false)
+ else
+ loop crlf_endings2 (pred k)
+ | exception End_of_file ->
+ (false, "", true)
+ in
+ loop true ignored_lines
+ in
+ Sys.with_input_file ~bin:true file1 @@ fun ic1 ->
+ if reached_end_file2 then
+ (* We reached the end of file2 while ignoring lines, so only an empty
+ file can be identical, as in the binary comparison case. *)
+ if in_channel_length ic1 = 0 then
+ Same
+ else
+ Different
+ else
+ (* file2 has at least one non-ignored line *)
+ match input_line ic1 with
+ | exception End_of_file -> Different
+ | line1 ->
+ let crlf_endings1 = last_is_cr line1 in
+ (* If both files appear to have CRLF endings, then there's no need
+ to attempt to normalise either. *)
+ let seq1 =
+ let normalise = crlf_endings1 && not crlf_endings2 in
+ line_seq_of_in_channel ~normalise ic1 line1 in
+ let seq2 =
+ let normalise = crlf_endings2 && not crlf_endings1 in
+ line_seq_of_in_channel ~normalise ic2 line2 in
+ try
+ if Seq.equal seq1 seq2 then
+ Same
+ else
+ raise Exit
+ with Exit ->
+ (* Either the lines weren't equal, or the file which was being
+ normalised suddenly had a line which didn't end CRLF. In this
+ case, the files must differ since only one file is ever being
+ normalised, so the earlier lines differed too. *)
+ Different
(* Version of Stdlib.really_input which stops at EOF, rather than raising
an exception. *)
Bytes.sub buf 0 bytes_read
let compare_binary_files bytes_to_ignore file1 file2 =
- let ic1 = open_in_bin file1 in
- let ic2 = open_in_bin file2 in
+ Sys.with_input_file ~bin:true file1 @@ fun ic1 ->
+ Sys.with_input_file ~bin:true file2 @@ fun ic2 ->
seek_in ic1 bytes_to_ignore;
seek_in ic2 bytes_to_ignore;
let rec compare () =
else
Different
in
- let result = compare () in
- close_in ic1;
- close_in ic2;
- result
+ compare ()
let compare_files ?(tool = default_comparison_tool) files =
match tool with
files.reference_filename;
files.output_filename
] in
- let dev_null = match Sys.os_type with
- | "Win32" -> "NUL"
- | _ -> "/dev/null" in
let settings = Run_command.settings_of_commandline
- ~stdout_fname:dev_null ~stderr_fname:dev_null commandline in
+ ~stdout_fname:Filename.null ~stderr_fname:Filename.null commandline in
let status = Run_command.run settings in
result_of_exitcode commandline status
| Internal ignore ->
let temporary_file = Filename.temp_file "ocamltest" "diff" in
let diff_commandline =
Filename.quote_command "diff" ~stdout:temporary_file
- [ "-u";
+ [ "--strip-trailing-cr"; "-u";
files.reference_filename;
files.output_filename ]
in
let result =
- if (Sys.command diff_commandline) = 2 then Stdlib.Error "diff"
- else Ok (Sys.string_of_file temporary_file)
+ match Sys.command diff_commandline with
+ | 0 -> Ok "Inconsistent LF/CRLF line-endings"
+ | 2 -> Stdlib.Error "diff"
+ | _ -> Ok (Sys.string_of_file temporary_file)
in
Sys.force_remove temporary_file;
result
-let promote files ignore_conf =
- match files.filetype, ignore_conf with
- | Text, {lines = skip_lines; _} ->
- let reference = open_out files.reference_filename in
- let output = open_in files.output_filename in
- for _ = 1 to skip_lines do
- try ignore (input_line output) with End_of_file -> ()
- done;
- Sys.copy_chan output reference;
- close_out reference;
- close_in output
- | Binary, {bytes = skip_bytes; _} ->
- let reference = open_out_bin files.reference_filename in
- let output = open_in_bin files.output_filename in
- seek_in output skip_bytes;
- Sys.copy_chan output reference;
- close_out reference;
- close_in output
+let promote {filetype; reference_filename; output_filename} ignore_conf =
+ match filetype, ignore_conf with
+ | Text, {lines = skip_lines; _} ->
+ Sys.with_output_file reference_filename @@ fun reference ->
+ Sys.with_input_file output_filename @@ fun output ->
+ for _ = 1 to skip_lines do
+ try ignore (input_line output) with End_of_file -> ()
+ done;
+ Sys.copy_chan output reference
+ | Binary, {bytes = skip_bytes; _} ->
+ Sys.with_output_file ~bin:true reference_filename @@ fun reference ->
+ Sys.with_input_file ~bin:true output_filename @@ fun output ->
+ seek_in output skip_bytes;
+ Sys.copy_chan output reference
tests_to_skip := String.words (Sys.safe_getenv "OCAMLTEST_SKIP_TESTS")
let test_file test_filename =
- (* Printf.printf "# reading test file %s\n%!" test_filename; *)
- (* Save current working directory *)
- let cwd = Sys.getcwd() in
let skip_test = List.mem test_filename !tests_to_skip in
let tsl_block = tsl_block_of_file_safe test_filename in
let (rootenv_statements, test_trees) = test_trees_of_tsl_block tsl_block in
let test_build_directory_prefix =
get_test_build_directory_prefix test_directory in
let clean_test_build_directory () =
- ignore
- (Sys.command
- (Filename.quote_command "rm" ["-rf"; test_build_directory_prefix]))
+ try
+ Sys.rm_rf test_build_directory_prefix
+ with Sys_error _ -> ()
in
clean_test_build_directory ();
Sys.make_directory test_build_directory_prefix;
+ let log_filename =
+ Filename.concat test_build_directory_prefix (test_prefix ^ ".log") in
+ let log =
+ if Options.log_to_stderr then stderr else begin
+ open_out log_filename
+ end in
let summary = Sys.with_chdir test_build_directory_prefix
(fun () ->
- let log =
- if !Options.log_to_stderr then stderr else begin
- let log_filename = test_prefix ^ ".log" in
- open_out log_filename
- end in
- let promote = string_of_bool !Options.promote in
+ let promote = string_of_bool Options.promote in
let install_hook name =
let hook_name = Filename.make_filename hookname_prefix name in
if Sys.file_exists hook_name then begin
test_build_directory_prefix;
Builtin_variables.promote, promote;
] in
- let root_environment =
+ let rootenv =
+ Environments.initialize Environments.Pre log initial_environment in
+ let rootenv =
interprete_environment_statements
- initial_environment rootenv_statements in
- let rootenv = Environments.initialize log root_environment in
+ rootenv rootenv_statements in
+ let rootenv = Environments.initialize Environments.Post log rootenv in
let common_prefix = " ... testing '" ^ test_basename ^ "' with" in
let initial_status =
if skip_test then Skip_all_tests else Run rootenv
let summary =
run_test_trees log common_prefix "" initial_status test_trees in
Actions.clear_all_hooks();
- if not !Options.log_to_stderr then close_out log;
summary
) in
- (* Restore current working directory *)
- Sys.chdir cwd;
+ if not Options.log_to_stderr then close_out log;
begin match summary with
- | Some_failure -> ()
+ | Some_failure ->
+ if not Options.log_to_stderr then
+ Sys.dump_file stderr ~prefix:"> " log_filename
| No_failure ->
- if not !Options.keep_test_dir_on_success then
+ if not Options.keep_test_dir_on_success then
clean_test_build_directory ()
end
let ignored s =
s = "" || s.[0] = '_' || s.[0] = '.'
+let sort_strings = List.sort String.compare
+
let find_test_dirs dir =
let res = ref [] in
let rec loop dir =
if !contains_tests then res := dir :: !res
in
loop dir;
- List.rev !res
+ sort_strings !res
let list_tests dir =
let res = ref [] in
end
) (Sys.readdir dir)
end;
- List.rev !res
+ sort_strings !res
let () =
init_tests_to_skip()
-let main () =
+let () =
let failed = ref false in
let work_done = ref false in
let list_tests dir =
in
let find_test_dirs dir = List.iter print_endline (find_test_dirs dir) in
let doit f x = work_done := true; f x in
- List.iter (doit find_test_dirs) !Options.find_test_dirs;
- List.iter (doit list_tests) !Options.list_tests;
- List.iter (doit test_file) !Options.files_to_test;
+ List.iter (doit find_test_dirs) Options.find_test_dirs;
+ List.iter (doit list_tests) Options.list_tests;
+ List.iter (doit test_file) Options.files_to_test;
if not !work_done then print_usage();
if !failed || not !work_done then exit 1
-
-let _ = main()
(* Extracting information from environment *)
-let native_support = Ocamltest_config.arch <> "none"
-
let no_native_compilers _log env =
(Result.skip_with_reason "native compilers disabled", env)
let native_action a =
- if native_support then a else (Actions.update a no_native_compilers)
+ if Ocamltest_config.native_compiler then a
+ else (Actions.update a no_native_compilers)
let get_backend_value_from_env env bytecode_var native_var =
Ocaml_backends.make_backend_function
type module_generator = {
description : string;
- command : string -> string;
+ command : string;
flags : Environments.t -> string;
generated_compilation_units :
string -> (string * Ocaml_filetypes.t) list
]
}
-let generate_module generator ocamlsrcdir output_variable input log env =
+let generate_module generator output_variable input log env =
let basename = fst input in
let input_file = Ocaml_filetypes.make_filename input in
let what =
Printf.fprintf log "%s\n%!" what;
let commandline =
[
- generator.command ocamlsrcdir;
+ generator.command;
generator.flags env;
input_file
] in
let generate_parser = generate_module ocamlyacc
-let prepare_module ocamlsrcdir output_variable log env input =
+let prepare_module output_variable log env input =
let input_type = snd input in
let open Ocaml_filetypes in
match input_type with
| Backend_specific _ -> [input]
| C_minus_minus -> assert false
| Lexer ->
- generate_lexer ocamlsrcdir output_variable input log env
+ generate_lexer output_variable input log env
| Grammar ->
- generate_parser ocamlsrcdir output_variable input log env
+ generate_parser output_variable input log env
| Text -> assert false
let get_program_file backend env =
begin try close_in ic with Sys_error _ -> () end;
Some (Error ("Corrupt or non-CMA file: " ^ library))
in
- Misc.Stdlib.List.find_map loads_c_code (String.words libraries)
+ List.find_map loads_c_code (String.words libraries)
-let compile_program ocamlsrcdir (compiler : Ocaml_compilers.compiler) log env =
+let compile_program (compiler : Ocaml_compilers.compiler) log env =
let program_variable = compiler#program_variable in
let program_file = Environments.safe_lookup program_variable env in
let all_modules =
Actions_helpers.words_of_variable env Ocaml_variables.all_modules in
let output_variable = compiler#output_variable in
- let prepare = prepare_module ocamlsrcdir output_variable log env in
+ let prepare = prepare_module output_variable log env in
let modules =
List.concatmap prepare (List.map Ocaml_filetypes.filetype all_modules) in
let has_c_file = List.exists is_c_file modules in
let c_headers_flags =
- if has_c_file then Ocaml_flags.c_includes ocamlsrcdir else "" in
+ if has_c_file then Ocaml_flags.c_includes else "" in
let expected_exit_status =
Ocaml_tools.expected_exit_status env (compiler :> Ocaml_tools.tool) in
let module_names =
let bytecode_links_c_code = (cmas_need_dynamic_loading = Some (Ok ())) in
let commandline =
[
- compiler#name ocamlsrcdir;
- Ocaml_flags.runtime_flags ocamlsrcdir env compiler#target
+ compiler#name;
+ Ocaml_flags.runtime_flags env compiler#target
(has_c_file || bytecode_links_c_code);
c_headers_flags;
- Ocaml_flags.stdlib ocamlsrcdir;
+ Ocaml_flags.stdlib;
directory_flags env;
flags env;
libraries;
(Result.fail_with_reason reason, env)
end
-let compile_module ocamlsrcdir compiler module_ log env =
+let compile_module compiler module_ log env =
let expected_exit_status =
Ocaml_tools.expected_exit_status env (compiler :> Ocaml_tools.tool) in
let what = Printf.sprintf "Compiling module %s" module_ in
let module_with_filetype = Ocaml_filetypes.filetype module_ in
let is_c = is_c_file module_with_filetype in
let c_headers_flags =
- if is_c then Ocaml_flags.c_includes ocamlsrcdir else "" in
+ if is_c then Ocaml_flags.c_includes else "" in
let commandline =
[
- compiler#name ocamlsrcdir;
- Ocaml_flags.stdlib ocamlsrcdir;
+ compiler#name;
+ Ocaml_flags.stdlib;
c_headers_flags;
directory_flags env;
flags env;
Ocaml_toplevels.ocamlnat)
let compile (compiler : Ocaml_compilers.compiler) log env =
- let ocamlsrcdir = Ocaml_directories.srcdir () in
match Environments.lookup_nonempty Builtin_variables.commandline env with
| None ->
begin
match Environments.lookup_nonempty Ocaml_variables.module_ env with
- | None -> compile_program ocamlsrcdir compiler log env
- | Some module_ -> compile_module ocamlsrcdir compiler module_ log env
+ | None -> compile_program compiler log env
+ | Some module_ -> compile_module compiler module_ log env
end
| Some cmdline ->
let expected_exit_status =
Ocaml_tools.expected_exit_status env (compiler :> Ocaml_tools.tool) in
let what = Printf.sprintf "Compiling using commandline %s" cmdline in
Printf.fprintf log "%s\n%!" what;
- let commandline = [compiler#name ocamlsrcdir; cmdline] in
+ let commandline = [compiler#name; cmdline] in
let exit_status =
Actions_helpers.run_cmd
~environment:default_ocaml_env
"ocamlopt.opt"
(compile Ocaml_compilers.ocamlopt_opt))
-let env_with_lib_unix ocamlsrcdir env =
- let libunixdir = Ocaml_directories.libunix ocamlsrcdir in
+let env_with_lib_unix env =
+ let libunixdir = Ocaml_directories.libunix in
let newlibs =
match Environments.lookup Ocaml_variables.caml_ld_library_path env with
| None -> libunixdir
Environments.add Ocaml_variables.caml_ld_library_path newlibs env
let debug log env =
- let ocamlsrcdir = Ocaml_directories.srcdir () in
let program = Environments.safe_lookup Builtin_variables.program env in
let what = Printf.sprintf "Debugging program %s" program in
Printf.fprintf log "%s\n%!" what;
let commandline =
[
- Ocaml_commands.ocamlrun_ocamldebug ocamlsrcdir;
- Ocaml_flags.ocamldebug_default_flags ocamlsrcdir;
+ Ocaml_commands.ocamlrun_ocamldebug;
+ Ocaml_flags.ocamldebug_default_flags;
program
] in
let systemenv =
Array.append
default_ocaml_env
- (Environments.to_system_env (env_with_lib_unix ocamlsrcdir env))
+ (Environments.to_system_env (env_with_lib_unix env))
in
let expected_exit_status = 0 in
let exit_status =
~stdout_variable:Builtin_variables.output
~stderr_variable:Builtin_variables.output
~append:true
- log (env_with_lib_unix ocamlsrcdir env) commandline in
+ log (env_with_lib_unix env) commandline in
if exit_status=expected_exit_status
then (Result.pass, env)
else begin
let ocamldebug = Actions.make "ocamldebug" debug
let objinfo log env =
- let ocamlsrcdir = Ocaml_directories.srcdir () in
- let tools_directory = Ocaml_directories.tools ocamlsrcdir in
+ let tools_directory = Ocaml_directories.tools in
let program = Environments.safe_lookup Builtin_variables.program env in
let what = Printf.sprintf "Running ocamlobjinfo on %s" program in
Printf.fprintf log "%s\n%!" what;
let commandline =
[
- Ocaml_commands.ocamlrun_ocamlobjinfo ocamlsrcdir;
+ Ocaml_commands.ocamlrun_ocamlobjinfo;
Ocaml_flags.ocamlobjinfo_default_flags;
program
] in
[
default_ocaml_env;
ocamllib;
- (Environments.to_system_env (env_with_lib_unix ocamlsrcdir env))
+ (Environments.to_system_env (env_with_lib_unix env))
]
in
let expected_exit_status = 0 in
~stdout_variable:Builtin_variables.output
~stderr_variable:Builtin_variables.output
~append:true
- log (env_with_lib_unix ocamlsrcdir env) commandline in
+ log (env_with_lib_unix env) commandline in
if exit_status=expected_exit_status
then (Result.pass, env)
else begin
let ocamlobjinfo = Actions.make "ocamlobjinfo" objinfo
let mklib log env =
- let ocamlsrcdir = Ocaml_directories.srcdir () in
let program = Environments.safe_lookup Builtin_variables.program env in
let what = Printf.sprintf "Running ocamlmklib to produce %s" program in
Printf.fprintf log "%s\n%!" what;
let ocamlc_command =
String.concat " "
[
- Ocaml_commands.ocamlrun_ocamlc ocamlsrcdir;
- Ocaml_flags.stdlib ocamlsrcdir;
+ Ocaml_commands.ocamlrun_ocamlc;
+ Ocaml_flags.stdlib;
]
in
let commandline =
[
- Ocaml_commands.ocamlrun_ocamlmklib ocamlsrcdir;
+ Ocaml_commands.ocamlrun_ocamlmklib;
"-ocamlc '" ^ ocamlc_command ^ "'";
"-o " ^ program
] @ modules env in
let ocamlmklib = Actions.make "ocamlmklib" mklib
-let finalise_codegen_cc ocamlsrcdir test_basename _log env =
+let finalise_codegen_cc test_basename _log env =
let test_module =
Filename.make_filename test_basename "s"
in
- let archmod = Ocaml_files.asmgen_archmod ocamlsrcdir in
+ let archmod = Ocaml_files.asmgen_archmod in
let modules = test_module ^ " " ^ archmod in
let program = Filename.make_filename test_basename "out" in
let env = Environments.add_bindings
] env in
(Result.pass, env)
-let finalise_codegen_msvc ocamlsrcdir test_basename log env =
+let finalise_codegen_msvc test_basename log env =
let obj = Filename.make_filename test_basename Ocamltest_config.objext in
let src = Filename.make_filename test_basename "s" in
let what = "Running Microsoft assembler" in
log env commandline in
if exit_status=expected_exit_status
then begin
- let archmod = Ocaml_files.asmgen_archmod ocamlsrcdir in
+ let archmod = Ocaml_files.asmgen_archmod in
let modules = obj ^ " " ^ archmod in
let program = Filename.make_filename test_basename "out" in
let env = Environments.add_bindings
end
let run_codegen log env =
- let ocamlsrcdir = Ocaml_directories.srcdir () in
let testfile = Actions_helpers.testfile env in
let testfile_basename = Filename.chop_extension testfile in
let what = Printf.sprintf "Running codegen on %s" testfile in
let env = Environments.add Builtin_variables.output output env in
let commandline =
[
- Ocaml_commands.ocamlrun_codegen ocamlsrcdir;
+ Ocaml_commands.ocamlrun_codegen;
flags env;
"-S " ^ testfile
] in
then finalise_codegen_msvc
else finalise_codegen_cc
in
- finalise ocamlsrcdir testfile_basename log env
+ finalise testfile_basename log env
end else begin
let reason =
(Actions_helpers.mkreason
let codegen = Actions.make "codegen" run_codegen
let run_cc log env =
- let ocamlsrcdir = Ocaml_directories.srcdir () in
let program = Environments.safe_lookup Builtin_variables.program env in
let what = Printf.sprintf "Running C compiler to build %s" program in
Printf.fprintf log "%s\n%!" what;
[
Ocamltest_config.cc;
Ocamltest_config.cflags;
- "-I" ^ Ocaml_directories.runtime ocamlsrcdir;
+ "-I" ^ Ocaml_directories.runtime;
output_exe ^ program;
Environments.safe_lookup Builtin_variables.arguments env;
] @ modules env in
let cc = Actions.make "cc" run_cc
-let run_expect_once ocamlsrcdir input_file principal log env =
+let run_expect_once input_file principal log env =
let expect_flags = Sys.safe_getenv "EXPECT_FLAGS" in
- let repo_root = "-repo-root " ^ ocamlsrcdir in
+ let repo_root = "-repo-root " ^ Ocaml_directories.srcdir in
let principal_flag = if principal then "-principal" else "" in
let commandline =
[
- Ocaml_commands.ocamlrun_expect_test ocamlsrcdir;
+ Ocaml_commands.ocamlrun_expect_test;
expect_flags;
flags env;
repo_root;
(Result.fail_with_reason reason, env)
end
-let run_expect_twice ocamlsrcdir input_file log env =
+let run_expect_twice input_file log env =
let corrected filename = Filename.make_filename filename "corrected" in
- let (result1, env1) = run_expect_once ocamlsrcdir input_file false log env in
+ let (result1, env1) = run_expect_once input_file false log env in
if Result.is_pass result1 then begin
let intermediate_file = corrected input_file in
let (result2, env2) =
- run_expect_once ocamlsrcdir intermediate_file true log env1 in
+ run_expect_once intermediate_file true log env1 in
if Result.is_pass result2 then begin
let output_file = corrected intermediate_file in
let output_env = Environments.add_bindings
end else (result1, env1)
let run_expect log env =
- let ocamlsrcdir = Ocaml_directories.srcdir () in
let input_file = Actions_helpers.testfile env in
- run_expect_twice ocamlsrcdir input_file log env
+ run_expect_twice input_file log env
let run_expect = Actions.make "run-expect" run_expect
Filecompare.reference_filename = program;
Filecompare.output_filename = program2
} in
- if Ocamltest_config.flambda && backend = Ocaml_backends.Native
- then begin
- let reason =
- "flambda temporarily disables comparison of native programs" in
- (Result.pass_with_reason reason, env)
- end else
- if backend = Ocaml_backends.Native &&
- (Sys.os_type="Win32" || Sys.os_type="Cygwin")
- then begin
- let reason =
- "comparison of native programs temporarily disabled under Windows" in
- (Result.pass_with_reason reason, env)
- end else begin
- let comparison_tool =
- if backend=Ocaml_backends.Native &&
- (Sys.os_type="Win32" || Sys.os_type="Cygwin")
- then
- let bytes_to_ignore = 512 (* comparison_start_address program *) in
- Filecompare.(make_cmp_tool ~ignore:{bytes=bytes_to_ignore; lines=0})
- else comparison_tool in
- match Filecompare.compare_files ~tool:comparison_tool files with
- | Filecompare.Same -> (Result.pass, env)
- | Filecompare.Different ->
- let reason = Printf.sprintf "Files %s and %s are different"
- program program2 in
- (Result.fail_with_reason reason, env)
- | Filecompare.Unexpected_output -> assert false
- | Filecompare.Error (commandline, exitcode) ->
- let reason = Actions_helpers.mkreason what commandline exitcode in
- (Result.fail_with_reason reason, env)
- end
+ match Filecompare.compare_files ~tool:comparison_tool files with
+ | Filecompare.Same -> (Result.pass, env)
+ | Filecompare.Different ->
+ let reason = Printf.sprintf "Files %s and %s are different"
+ program program2 in
+ (Result.fail_with_reason reason, env)
+ | Filecompare.Unexpected_output -> assert false
+ | Filecompare.Error (commandline, exitcode) ->
+ let reason = Actions_helpers.mkreason what commandline exitcode in
+ (Result.fail_with_reason reason, env)
let compare_programs backend comparison_tool log env =
let compare_programs =
(Result.pass_with_reason reason, env)
end else really_compare_programs backend comparison_tool log env
-let make_bytecode_programs_comparison_tool ocamlsrcdir =
- let ocamlrun = Ocaml_files.ocamlrun ocamlsrcdir in
- let cmpbyt = Ocaml_files.cmpbyt ocamlsrcdir in
+let make_bytecode_programs_comparison_tool =
+ let ocamlrun = Ocaml_files.ocamlrun in
+ let cmpbyt = Ocaml_files.cmpbyt in
let tool_name = ocamlrun ^ " " ^ cmpbyt in
Filecompare.make_comparison_tool tool_name ""
let native_programs_comparison_tool = Filecompare.default_comparison_tool
let compare_bytecode_programs_code log env =
- let ocamlsrcdir = Ocaml_directories.srcdir () in
let bytecode_programs_comparison_tool =
- make_bytecode_programs_comparison_tool ocamlsrcdir in
+ make_bytecode_programs_comparison_tool in
compare_programs
Ocaml_backends.Bytecode bytecode_programs_comparison_tool log env
"compare-bytecode-programs"
compare_bytecode_programs_code)
-let compare_native_programs =
+let compare_binary_files =
native_action
(Actions.make
- "compare-native-programs"
+ "compare-binary-files"
(compare_programs Ocaml_backends.Native native_programs_comparison_tool))
-let compile_module
- ocamlsrcdir compiler compilername compileroutput log env
+let compile_module compiler compilername compileroutput log env
(module_basename, module_filetype) =
let backend = compiler#target in
let filename =
| Some file -> "-o " ^ file in
[
compilername;
- Ocaml_flags.stdlib ocamlsrcdir;
+ Ocaml_flags.stdlib;
flags env;
backend_flags env backend;
optional_flags;
let _object_filename = module_basename ^ object_extension in
let commandline =
compile_commandline filename None
- (Ocaml_flags.c_includes ocamlsrcdir) in
+ Ocaml_flags.c_includes in
exec commandline
| _ ->
let reason = Printf.sprintf "File %s of type %s not supported yet"
filename (Ocaml_filetypes.string_of_filetype module_filetype) in
(Result.fail_with_reason reason, env)
-let compile_modules
- ocamlsrcdir compiler compilername compileroutput
+let compile_modules compiler compilername compileroutput
modules_with_filetypes log initial_env
=
let compile_mod env mod_ =
- compile_module ocamlsrcdir compiler compilername compileroutput
+ compile_module compiler compilername compileroutput
log env mod_ in
let rec compile_mods env = function
| [] -> (Result.pass, env)
(* This is a sub-optimal check - skip the test if any libraries requiring
C stubs are loaded. It would be better at this point to build a custom
toplevel. *)
- let toplevel_can_run =
+ let toplevel_supports_dynamic_loading =
Config.supports_shared_libraries || backend <> Ocaml_backends.Bytecode
in
- if not toplevel_can_run then
- (Result.skip, env)
- else
- match cmas_need_dynamic_loading (directories env) libraries with
- | Some (Error reason) ->
- (Result.fail_with_reason reason, env)
- | Some (Ok ()) ->
- (Result.skip, env)
- | None ->
- let testfile = Actions_helpers.testfile env in
- let expected_exit_status =
- Ocaml_tools.expected_exit_status env (toplevel :> Ocaml_tools.tool) in
- let compiler_output_variable = toplevel#output_variable in
- let ocamlsrcdir = Ocaml_directories.srcdir () in
- let compiler = toplevel#compiler in
- let compiler_name = compiler#name ocamlsrcdir in
- let modules_with_filetypes =
- List.map Ocaml_filetypes.filetype (modules env) in
- let (result, env) = compile_modules
- ocamlsrcdir compiler compiler_name compiler_output_variable
- modules_with_filetypes log env in
- if Result.is_pass result then begin
- let what =
- Printf.sprintf "Running %s in %s toplevel \
- (expected exit status: %d)"
- testfile
- (Ocaml_backends.string_of_backend backend)
- expected_exit_status in
- Printf.fprintf log "%s\n%!" what;
- let toplevel_name = toplevel#name ocamlsrcdir in
- let ocaml_script_as_argument =
- match
- Environments.lookup_as_bool
- Ocaml_variables.ocaml_script_as_argument env
- with
- | None -> false
- | Some b -> b
- in
- let commandline =
- [
- toplevel_name;
- Ocaml_flags.toplevel_default_flags;
- toplevel#flags;
- Ocaml_flags.stdlib ocamlsrcdir;
- directory_flags env;
- Ocaml_flags.include_toplevel_directory ocamlsrcdir;
- flags env;
- libraries;
- binary_modules backend env;
- if ocaml_script_as_argument then testfile else "";
- Environments.safe_lookup Builtin_variables.arguments env
- ] in
- let exit_status =
- if ocaml_script_as_argument
- then Actions_helpers.run_cmd
- ~environment:default_ocaml_env
- ~stdout_variable:compiler_output_variable
- ~stderr_variable:compiler_output_variable
- log env commandline
- else Actions_helpers.run_cmd
- ~environment:default_ocaml_env
- ~stdin_variable:Builtin_variables.test_file
- ~stdout_variable:compiler_output_variable
- ~stderr_variable:compiler_output_variable
- log env commandline
- in
- if exit_status=expected_exit_status
- then (Result.pass, env)
- else begin
- let reason =
- (Actions_helpers.mkreason
- what (String.concat " " commandline) exit_status) in
- (Result.fail_with_reason reason, env)
- end
- end else (result, env)
+ match cmas_need_dynamic_loading (directories env) libraries with
+ | Some (Error reason) ->
+ (Result.fail_with_reason reason, env)
+ | Some (Ok ()) when not toplevel_supports_dynamic_loading ->
+ (Result.skip, env)
+ | _ ->
+ let testfile = Actions_helpers.testfile env in
+ let expected_exit_status =
+ Ocaml_tools.expected_exit_status env (toplevel :> Ocaml_tools.tool) in
+ let compiler_output_variable = toplevel#output_variable in
+ let compiler = toplevel#compiler in
+ let compiler_name = compiler#name in
+ let modules_with_filetypes =
+ List.map Ocaml_filetypes.filetype (modules env) in
+ let (result, env) = compile_modules
+ compiler compiler_name compiler_output_variable
+ modules_with_filetypes log env in
+ if Result.is_pass result then begin
+ let what =
+ Printf.sprintf "Running %s in %s toplevel \
+ (expected exit status: %d)"
+ testfile
+ (Ocaml_backends.string_of_backend backend)
+ expected_exit_status in
+ Printf.fprintf log "%s\n%!" what;
+ let toplevel_name = toplevel#name in
+ let ocaml_script_as_argument =
+ match
+ Environments.lookup_as_bool
+ Ocaml_variables.ocaml_script_as_argument env
+ with
+ | None -> false
+ | Some b -> b
+ in
+ let commandline =
+ [
+ toplevel_name;
+ Ocaml_flags.toplevel_default_flags;
+ toplevel#flags;
+ Ocaml_flags.stdlib;
+ directory_flags env;
+ Ocaml_flags.include_toplevel_directory;
+ flags env;
+ libraries;
+ binary_modules backend env;
+ if ocaml_script_as_argument then testfile else "";
+ Environments.safe_lookup Builtin_variables.arguments env
+ ] in
+ let exit_status =
+ if ocaml_script_as_argument
+ then Actions_helpers.run_cmd
+ ~environment:default_ocaml_env
+ ~stdout_variable:compiler_output_variable
+ ~stderr_variable:compiler_output_variable
+ log env commandline
+ else Actions_helpers.run_cmd
+ ~environment:default_ocaml_env
+ ~stdin_variable:Builtin_variables.test_file
+ ~stdout_variable:compiler_output_variable
+ ~stderr_variable:compiler_output_variable
+ log env commandline
+ in
+ if exit_status=expected_exit_status
+ then (Result.pass, env)
+ else begin
+ let reason =
+ (Actions_helpers.mkreason
+ what (String.concat " " commandline) exit_status) in
+ (Result.fail_with_reason reason, env)
+ end
+ end else (result, env)
let ocaml = Actions.make
"ocaml"
"check-ocamlnat-output" Ocaml_toplevels.ocamlnat)
let config_variables _log env =
- let ocamlsrcdir = Ocaml_directories.srcdir () in
Environments.add_bindings
[
Ocaml_variables.arch, Ocamltest_config.arch;
- Ocaml_variables.ocamlrun, Ocaml_files.ocamlrun ocamlsrcdir;
- Ocaml_variables.ocamlc_byte, Ocaml_files.ocamlc ocamlsrcdir;
- Ocaml_variables.ocamlopt_byte, Ocaml_files.ocamlopt ocamlsrcdir;
+ Ocaml_variables.ocamlrun, Ocaml_files.ocamlrun;
+ Ocaml_variables.ocamlc_byte, Ocaml_files.ocamlc;
+ Ocaml_variables.ocamlopt_byte, Ocaml_files.ocamlopt;
Ocaml_variables.bytecc_libs, Ocamltest_config.bytecc_libs;
Ocaml_variables.nativecc_libs, Ocamltest_config.nativecc_libs;
Ocaml_variables.mkdll,
Sys.getenv_with_default_value "MKDLL" Ocamltest_config.mkdll;
Ocaml_variables.mkexe, Ocamltest_config.mkexe;
Ocaml_variables.c_preprocessor, Ocamltest_config.c_preprocessor;
+ Ocaml_variables.cc, Ocamltest_config.cc;
Ocaml_variables.csc, Ocamltest_config.csc;
Ocaml_variables.csc_flags, Ocamltest_config.csc_flags;
Ocaml_variables.shared_library_cflags,
Ocaml_variables.ocamlopt_default_flags,
Ocamltest_config.ocamlopt_default_flags;
Ocaml_variables.ocamlrunparam, Sys.safe_getenv "OCAMLRUNPARAM";
- Ocaml_variables.ocamlsrcdir, Ocaml_directories.srcdir();
+ Ocaml_variables.ocamlsrcdir, Ocaml_directories.srcdir;
Ocaml_variables.os_type, Sys.os_type;
] env
"support for flambda disabled"
"support for flambda enabled")
-let spacetime = Actions.make
- "spacetime"
- (Actions_helpers.pass_or_skip Ocamltest_config.spacetime
- "support for spacetime enabled"
- "support for spacetime disabled")
-
-let no_spacetime = make
- "no-spacetime"
- (Actions_helpers.pass_or_skip (not Ocamltest_config.spacetime)
- "support for spacetime disabled"
- "support for spacetime enabled")
-
let shared_libraries = Actions.make
"shared-libraries"
(Actions_helpers.pass_or_skip Ocamltest_config.shared_libraries
let native_compiler = Actions.make
"native-compiler"
- (Actions_helpers.pass_or_skip (Ocamltest_config.arch <> "none")
+ (Actions_helpers.pass_or_skip Ocamltest_config.native_compiler
"native compiler available"
"native compiler not available")
(* The compiler used for compiling both cmi file
and plugins *)
-let compiler_for_ocamldoc ocamlsrcdir =
+let compiler_for_ocamldoc =
let compiler = Ocaml_compilers.ocamlc_byte in
- compile_modules ocamlsrcdir compiler (compiler#name ocamlsrcdir)
+ compile_modules compiler compiler#name
compiler#output_variable
(* Within ocamldoc tests,
secondaries documentation modules that need to be
compiled into cmi files and odoc file (serialized ocamldoc information)
before the main documentation is generated *)
-let compile_ocamldoc ocamlsrcdir (basename,filetype as module_) log env =
+let compile_ocamldoc (basename,filetype as module_) log env =
let expected_exit_status =
Ocaml_tools.expected_exit_status env (ocamldoc :> Ocaml_tools.tool) in
let what = Printf.sprintf "Compiling documentation for module %s" basename in
Printf.fprintf log "%s\n%!" what;
let filename =
Ocaml_filetypes.make_filename (basename, filetype) in
- let (r,env) = compiler_for_ocamldoc ocamlsrcdir [module_] log env in
+ let (r,env) = compiler_for_ocamldoc [module_] log env in
if not (Result.is_pass r) then (r,env) else
let commandline =
(* currently, we are ignoring the global ocamldoc_flags, since we
don't have per-module flags *)
[
- Ocaml_commands.ocamlrun_ocamldoc ocamlsrcdir;
- Ocaml_flags.stdlib ocamlsrcdir;
+ Ocaml_commands.ocamlrun_ocamldoc;
+ Ocaml_flags.stdlib;
"-dump " ^ compiled_doc_name basename;
filename;
] in
(Result.fail_with_reason reason, env)
end
-let rec ocamldoc_compile_all ocamlsrcdir log env = function
+let rec ocamldoc_compile_all log env = function
| [] -> (Result.pass, env)
| a :: q ->
- let (r,env) = compile_ocamldoc ocamlsrcdir a log env in
+ let (r,env) = compile_ocamldoc a log env in
if Result.is_pass r then
- ocamldoc_compile_all ocamlsrcdir log env q
+ ocamldoc_compile_all log env q
else
(r,env)
let modules = List.map Ocaml_filetypes.filetype @@ modules env in
(* plugins are used for custom documentation generators *)
let plugins = List.map Ocaml_filetypes.filetype @@ plugins env in
- let ocamlsrcdir = Ocaml_directories.srcdir () in
- let (r,env) = compiler_for_ocamldoc ocamlsrcdir plugins log env in
+ let (r,env) = compiler_for_ocamldoc plugins log env in
if not (Result.is_pass r) then r, env else
- let (r,env) = ocamldoc_compile_all ocamlsrcdir log env modules in
+ let (r,env) = ocamldoc_compile_all log env modules in
if not (Result.is_pass r) then r, env else
let input_file = Actions_helpers.testfile env in
Printf.fprintf log "Generating documentation for %s\n%!" input_file;
List.map (fun name -> "-g " ^ ocamldoc_plugin (fst name)) plugins in
let commandline =
[
- Ocaml_commands.ocamlrun_ocamldoc ocamlsrcdir;
+ Ocaml_commands.ocamlrun_ocamldoc;
ocamldoc_backend_flag env;
- Ocaml_flags.stdlib ocamlsrcdir;
+ Ocaml_flags.stdlib;
ocamldoc_flags env]
@ load_all @ with_plugins @
[ input_file;
end
let _ =
- Environments.register_initializer "find_source_modules" find_source_modules;
- Environments.register_initializer "config_variables" config_variables;
+ Environments.register_initializer Environments.Post
+ "find_source_modules" find_source_modules;
+ Environments.register_initializer Environments.Pre
+ "config_variables" config_variables;
List.iter register
[
setup_ocamlc_byte_build_env;
check_ocamlopt_opt_output;
run_expect;
compare_bytecode_programs;
- compare_native_programs;
+ compare_binary_files;
setup_ocaml_build_env;
ocaml;
check_ocaml_output;
no_flat_float_array;
flambda;
no_flambda;
- spacetime;
- no_spacetime;
shared_libraries;
no_shared_libraries;
native_compiler;
val check_ocamlopt_opt_output : Actions.t
val run_expect : Actions.t
val compare_bytecode_programs : Actions.t
-val compare_native_programs : Actions.t
+val compare_binary_files : Actions.t
val setup_ocaml_build_env : Actions.t
val ocaml : Actions.t
val check_ocaml_output : Actions.t
(* Helper functions to build OCaml-related commands *)
-let ocamlrun ocamlsrcdir program =
- (Ocaml_files.ocamlrun ocamlsrcdir) ^ " " ^ (program ocamlsrcdir)
+let ocamlrun program =
+ Ocaml_files.ocamlrun ^ " " ^ program
-let ocamlrun_ocamlc ocamlsrcdir = ocamlrun ocamlsrcdir Ocaml_files.ocamlc
+let ocamlrun_ocamlc = ocamlrun Ocaml_files.ocamlc
-let ocamlrun_ocamlopt ocamlsrcdir = ocamlrun ocamlsrcdir Ocaml_files.ocamlopt
+let ocamlrun_ocamlopt = ocamlrun Ocaml_files.ocamlopt
-let ocamlrun_ocaml ocamlsrcdir = ocamlrun ocamlsrcdir Ocaml_files.ocaml
+let ocamlrun_ocaml = ocamlrun Ocaml_files.ocaml
-let ocamlrun_expect_test ocamlsrcdir =
- ocamlrun ocamlsrcdir Ocaml_files.expect_test
+let ocamlrun_expect_test =
+ ocamlrun Ocaml_files.expect_test
-let ocamlrun_ocamllex ocamlsrcdir = ocamlrun ocamlsrcdir Ocaml_files.ocamllex
+let ocamlrun_ocamllex = ocamlrun Ocaml_files.ocamllex
-let ocamlrun_ocamldoc ocamlsrcdir =
- ocamlrun ocamlsrcdir Ocaml_files.ocamldoc
+let ocamlrun_ocamldoc =
+ ocamlrun Ocaml_files.ocamldoc
-let ocamlrun_ocamldebug ocamlsrcdir =
- ocamlrun ocamlsrcdir Ocaml_files.ocamldebug
+let ocamlrun_ocamldebug =
+ ocamlrun Ocaml_files.ocamldebug
-let ocamlrun_ocamlobjinfo ocamlsrcdir =
- ocamlrun ocamlsrcdir Ocaml_files.ocamlobjinfo
+let ocamlrun_ocamlobjinfo =
+ ocamlrun Ocaml_files.ocamlobjinfo
-let ocamlrun_ocamlmklib ocamlsrcdir =
- ocamlrun ocamlsrcdir Ocaml_files.ocamlmklib
+let ocamlrun_ocamlmklib =
+ ocamlrun Ocaml_files.ocamlmklib
-let ocamlrun_codegen ocamlsrcdir =
- ocamlrun ocamlsrcdir Ocaml_files.codegen
+let ocamlrun_codegen =
+ ocamlrun Ocaml_files.codegen
(* Helper functions to build OCaml-related commands *)
-val ocamlrun_ocamlc : string -> string
+val ocamlrun_ocamlc : string
-val ocamlrun_ocamlopt : string -> string
+val ocamlrun_ocamlopt : string
-val ocamlrun_ocaml : string -> string
+val ocamlrun_ocaml : string
-val ocamlrun_expect_test : string -> string
+val ocamlrun_expect_test : string
-val ocamlrun_ocamllex : string -> string
+val ocamlrun_ocamllex : string
-val ocamlrun_ocamldoc : string -> string
+val ocamlrun_ocamldoc : string
-val ocamlrun_ocamldebug : string -> string
+val ocamlrun_ocamldebug : string
-val ocamlrun_ocamlobjinfo : string -> string
+val ocamlrun_ocamlobjinfo : string
-val ocamlrun_ocamlmklib : string -> string
-val ocamlrun_codegen : string -> string
+val ocamlrun_ocamlmklib : string
+val ocamlrun_codegen : string
open Ocamltest_stdlib
class compiler
- ~(name : string -> string)
+ ~(name : string)
~(flags : string)
~(directory : string)
~(exit_status_variable : Variables.t)
(* Descriptions of the OCaml compilers *)
class compiler :
- name : (string -> string) ->
+ name : string ->
flags : string ->
directory : string ->
exit_status_variable : Variables.t ->
open Ocamltest_stdlib
-let srcdir () =
+let srcdir =
Sys.getenv_with_default_value "OCAMLSRCDIR" Ocamltest_config.ocamlsrcdir
-let stdlib ocamlsrcdir =
- Filename.make_path [ocamlsrcdir; "stdlib"]
+let stdlib =
+ Filename.make_path [srcdir; "stdlib"]
-let libunix ocamlsrcdir =
- let subdir = if Sys.os_type="Win32" then "win32unix" else "unix" in
- Filename.make_path [ocamlsrcdir; "otherlibs"; subdir]
+let libunix =
+ let subdir = if Sys.win32 then "win32unix" else "unix" in
+ Filename.make_path [srcdir; "otherlibs"; subdir]
-let toplevel ocamlsrcdir =
- Filename.make_path [ocamlsrcdir; "toplevel"]
+let toplevel =
+ Filename.make_path [srcdir; "toplevel"]
-let runtime ocamlsrcdir =
- Filename.make_path [ocamlsrcdir; "runtime"]
+let runtime =
+ Filename.make_path [srcdir; "runtime"]
-let tools ocamlsrcdir =
- Filename.make_path [ocamlsrcdir; "tools"]
+let tools =
+ Filename.make_path [srcdir; "tools"]
(* Locations of directories in the OCaml source tree *)
-val srcdir : unit -> string
+val srcdir : string
-val stdlib : string -> string
+val stdlib : string
-val libunix : string -> string
+val libunix : string
-val toplevel : string -> string
+val toplevel : string
-val runtime : string -> string
+val runtime : string
-val tools : string -> string
+val tools : string
else if use_runtime="i" then Instrumented
else Normal
-let ocamlrun ocamlsrcdir =
+let ocamlrun =
let runtime = match runtime_variant () with
| Normal -> "ocamlrun"
| Debug -> "ocamlrund"
| Instrumented -> "ocamlruni" in
let ocamlrunfile = Filename.mkexe runtime in
- Filename.make_path [ocamlsrcdir; "runtime"; ocamlrunfile]
+ Filename.make_path [Ocaml_directories.srcdir; "runtime"; ocamlrunfile]
-let ocamlc ocamlsrcdir =
- Filename.make_path [ocamlsrcdir; "ocamlc"]
+let ocamlc =
+ Filename.make_path [Ocaml_directories.srcdir; Filename.mkexe "ocamlc"]
-let ocaml ocamlsrcdir =
- Filename.make_path [ocamlsrcdir; "ocaml"]
+let ocaml =
+ Filename.make_path [Ocaml_directories.srcdir; Filename.mkexe "ocaml"]
-let ocamlc_dot_opt ocamlsrcdir =
- Filename.make_path [ocamlsrcdir; "ocamlc.opt"]
+let ocamlc_dot_opt =
+ Filename.make_path [Ocaml_directories.srcdir; Filename.mkexe "ocamlc.opt"]
-let ocamlopt ocamlsrcdir =
- Filename.make_path [ocamlsrcdir; "ocamlopt"]
+let ocamlopt =
+ Filename.make_path [Ocaml_directories.srcdir; Filename.mkexe "ocamlopt"]
-let ocamlopt_dot_opt ocamlsrcdir =
- Filename.make_path [ocamlsrcdir; "ocamlopt.opt"]
+let ocamlopt_dot_opt =
+ Filename.make_path [Ocaml_directories.srcdir; Filename.mkexe "ocamlopt.opt"]
-let ocamlnat ocamlsrcdir =
- Filename.make_path [ocamlsrcdir; Filename.mkexe "ocamlnat"]
+let ocamlnat =
+ Filename.make_path [Ocaml_directories.srcdir; Filename.mkexe "ocamlnat"]
-let cmpbyt ocamlsrcdir =
- Filename.make_path [ocamlsrcdir; "tools"; "cmpbyt"]
+let cmpbyt =
+ Filename.make_path
+ [Ocaml_directories.srcdir; "tools"; Filename.mkexe "cmpbyt"]
-let expect_test ocamlsrcdir =
+let expect_test =
Filename.make_path
- [ocamlsrcdir; "testsuite"; "tools"; Filename.mkexe "expect_test"]
+ [Ocaml_directories.srcdir; "testsuite"; "tools";
+ Filename.mkexe "expect_test"]
-let ocamllex ocamlsrcdir =
- Filename.make_path [ocamlsrcdir; "lex"; "ocamllex"]
+let ocamllex =
+ Filename.make_path
+ [Ocaml_directories.srcdir; "lex"; Filename.mkexe "ocamllex"]
-let ocamlyacc ocamlsrcdir =
- Filename.make_path [ocamlsrcdir; "yacc"; Filename.mkexe "ocamlyacc"]
+let ocamlyacc =
+ Filename.make_path
+ [Ocaml_directories.srcdir; "yacc"; Filename.mkexe "ocamlyacc"]
-let ocamldoc ocamlsrcdir =
- Filename.make_path [ocamlsrcdir; "ocamldoc"; "ocamldoc"]
+let ocamldoc =
+ Filename.make_path
+ [Ocaml_directories.srcdir; "ocamldoc"; Filename.mkexe "ocamldoc"]
-let ocamldebug ocamlsrcdir =
- Filename.make_path [ocamlsrcdir; "debugger"; Filename.mkexe "ocamldebug"]
+let ocamldebug =
+ Filename.make_path
+ [Ocaml_directories.srcdir; "debugger"; Filename.mkexe "ocamldebug"]
-let ocamlobjinfo ocamlsrcdir =
- Filename.make_path [ocamlsrcdir; "tools"; "ocamlobjinfo"]
+let ocamlobjinfo =
+ Filename.make_path
+ [Ocaml_directories.srcdir; "tools"; Filename.mkexe "ocamlobjinfo"]
-let ocamlmklib ocamlsrcdir =
- Filename.make_path [ocamlsrcdir; "tools"; "ocamlmklib"]
+let ocamlmklib =
+ Filename.make_path
+ [Ocaml_directories.srcdir; "tools"; Filename.mkexe "ocamlmklib"]
-let codegen ocamlsrcdir =
- Filename.make_path [ocamlsrcdir; "testsuite"; "tools"; "codegen"]
+let codegen =
+ Filename.make_path
+ [Ocaml_directories.srcdir; "testsuite"; "tools"; Filename.mkexe "codegen"]
-let asmgen_archmod ocamlsrcdir =
+let asmgen_archmod =
let objname =
"asmgen_" ^ Ocamltest_config.arch ^ "." ^ Ocamltest_config.objext
in
- Filename.make_path [ocamlsrcdir; "testsuite"; "tools"; objname]
+ Filename.make_path [Ocaml_directories.srcdir; "testsuite"; "tools"; objname]
val runtime_variant : unit -> runtime_variant
-val ocamlrun : string -> string
+val ocamlrun : string
-val ocamlc : string -> string
+val ocamlc : string
-val ocaml : string -> string
+val ocaml : string
-val ocamlc_dot_opt : string -> string
+val ocamlc_dot_opt : string
-val ocamlopt : string -> string
+val ocamlopt : string
-val ocamlopt_dot_opt : string -> string
+val ocamlopt_dot_opt : string
-val ocamlnat : string -> string
+val ocamlnat : string
-val cmpbyt : string -> string
+val cmpbyt : string
-val expect_test : string -> string
+val expect_test : string
-val ocamllex : string -> string
+val ocamllex : string
-val ocamlyacc : string -> string
+val ocamlyacc : string
-val ocamldoc : string -> string
-val ocamldebug : string -> string
-val ocamlobjinfo : string -> string
-val ocamlmklib : string -> string
-val codegen : string -> string
+val ocamldoc : string
+val ocamldebug : string
+val ocamlobjinfo : string
+val ocamlmklib : string
+val codegen : string
-val asmgen_archmod : string -> string
+val asmgen_archmod : string
(* Flags used in OCaml commands *)
-let stdlib ocamlsrcdir =
- let stdlib_path = Ocaml_directories.stdlib ocamlsrcdir in
+let stdlib =
+ let stdlib_path = Ocaml_directories.stdlib in
"-nostdlib -I " ^ stdlib_path
-let include_toplevel_directory ocamlsrcdir =
- "-I " ^ (Ocaml_directories.toplevel ocamlsrcdir)
+let include_toplevel_directory =
+ "-I " ^ Ocaml_directories.toplevel
-let c_includes ocamlsrcdir =
- let dir = Ocaml_directories.runtime ocamlsrcdir in
+let c_includes =
+ let dir = Ocaml_directories.runtime in
"-ccopt -I" ^ dir
let runtime_variant_flags () = match Ocaml_files.runtime_variant() with
| Ocaml_files.Debug -> " -runtime-variant d"
| Ocaml_files.Instrumented -> " -runtime-variant i"
-let runtime_flags ocamlsrcdir env backend c_files =
+let runtime_flags env backend c_files =
let runtime_library_flags = "-I " ^
- (Ocaml_directories.runtime ocamlsrcdir) in
+ Ocaml_directories.runtime in
let rt_flags = match backend with
| Ocaml_backends.Native -> runtime_variant_flags ()
| Ocaml_backends.Bytecode ->
in
if use_runtime = Some false
then ""
- else "-use-runtime " ^ (Ocaml_files.ocamlrun ocamlsrcdir)
+ else "-use-runtime " ^ Ocaml_files.ocamlrun
end
end in
rt_flags ^ " " ^ runtime_library_flags
let toplevel_default_flags = "-noinit -no-version -noprompt"
-let ocamldebug_default_flags ocamlsrcdir =
+let ocamldebug_default_flags =
"-no-version -no-prompt -no-time -no-breakpoint-message " ^
- ("-I " ^ (Ocaml_directories.stdlib ocamlsrcdir) ^ " ") ^
- ("-topdirs-path " ^ (Ocaml_directories.toplevel ocamlsrcdir))
+ ("-I " ^ Ocaml_directories.stdlib ^ " ") ^
+ ("-topdirs-path " ^ Ocaml_directories.toplevel)
let ocamlobjinfo_default_flags = "-null-crc"
(* Flags used in OCaml commands *)
-val stdlib : string -> string
+val stdlib : string
-val include_toplevel_directory : string -> string
+val include_toplevel_directory : string
-val c_includes : string -> string
+val c_includes : string
val runtime_flags :
- string -> Environments.t -> Ocaml_backends.t -> bool -> string
+ Environments.t -> Ocaml_backends.t -> bool -> string
val toplevel_default_flags : string
-val ocamldebug_default_flags : string -> string
+val ocamldebug_default_flags : string
val ocamlobjinfo_default_flags : string
open Ocamltest_stdlib
open Environments
+let wrap sl = " " ^ String.concat " " sl ^ " "
+let append var sl = Append (var, wrap sl)
+let add var s = Add (var, s)
+
let principal =
[
- Append (Ocaml_variables.flags, " -principal ");
- Add (Ocaml_variables.compiler_directory_suffix, ".principal");
- Add (Ocaml_variables.compiler_reference_suffix, ".principal");
+ append Ocaml_variables.flags ["-principal"];
+ add Ocaml_variables.compiler_directory_suffix ".principal";
+ add Ocaml_variables.compiler_reference_suffix ".principal";
]
let latex =
[
- Add (Ocaml_variables.ocamldoc_backend, "latex");
- Append (Ocaml_variables.ocamldoc_flags, "-latex-type-prefix=TYP ");
- Append (Ocaml_variables.ocamldoc_flags, "-latex-module-prefix= ");
- Append (Ocaml_variables.ocamldoc_flags, "-latex-value-prefix= ");
- Append (Ocaml_variables.ocamldoc_flags, "-latex-module-type-prefix= ");
- Append (Ocaml_variables.ocamldoc_flags, "-latextitle=1,subsection* ");
- Append (Ocaml_variables.ocamldoc_flags, "-latextitle=2,subsubsection* ");
- Append (Ocaml_variables.ocamldoc_flags, "-latextitle=6,subsection* ");
- Append (Ocaml_variables.ocamldoc_flags, "-latextitle=7,subsubsection* ");
+ add Ocaml_variables.ocamldoc_backend "latex";
+ append Ocaml_variables.ocamldoc_flags ["-latex-type-prefix=TYP"];
+ append Ocaml_variables.ocamldoc_flags ["-latex-module-prefix="];
+ append Ocaml_variables.ocamldoc_flags ["-latex-value-prefix="];
+ append Ocaml_variables.ocamldoc_flags ["-latex-module-type-prefix="];
+ append Ocaml_variables.ocamldoc_flags ["-latextitle=1,subsection*"];
+ append Ocaml_variables.ocamldoc_flags ["-latextitle=2,subsubsection*"];
+ append Ocaml_variables.ocamldoc_flags ["-latextitle=6,subsection*"];
+ append Ocaml_variables.ocamldoc_flags ["-latextitle=7,subsubsection*"];
]
let html =
[
- Add (Ocaml_variables.ocamldoc_backend, "html");
- Append (Ocaml_variables.ocamldoc_flags, "-colorize-code ");
+ add Ocaml_variables.ocamldoc_backend "html";
+ append Ocaml_variables.ocamldoc_flags ["-colorize-code"];
]
let man =
[
- Add (Ocaml_variables.ocamldoc_backend, "man");
+ add Ocaml_variables.ocamldoc_backend "man";
]
-let wrap str = (" " ^ str ^ " ")
-
-let make_library_modifier library directory =
+let make_library_modifier library directories =
[
- Append (Ocaml_variables.directories, (wrap directory));
- Append (Ocaml_variables.libraries, (wrap library));
- Append (Ocaml_variables.caml_ld_library_path, (wrap directory));
+ append Ocaml_variables.directories directories;
+ append Ocaml_variables.libraries [library];
+ append Ocaml_variables.caml_ld_library_path directories;
]
let make_module_modifier unit_name directory =
[
- Append (Ocaml_variables.directories, (wrap directory));
- Append (Ocaml_variables.binary_modules, (wrap unit_name));
+ append Ocaml_variables.directories [directory];
+ append Ocaml_variables.binary_modules [unit_name];
]
let compiler_subdir subdir =
let config =
[
- Append (Ocaml_variables.directories, (wrap (compiler_subdir ["utils"])));
+ append Ocaml_variables.directories [compiler_subdir ["utils"]];
]
let testing = make_library_modifier
- "testing" (compiler_subdir ["testsuite"; "lib"])
+ "testing" [compiler_subdir ["testsuite"; "lib"]]
let tool_ocaml_lib = make_module_modifier
"lib" (compiler_subdir ["testsuite"; "lib"])
-let unixlibdir = if Sys.os_type="Win32" then "win32unix" else "unix"
+let unixlibdir = if Sys.win32 then "win32unix" else "unix"
let unix = make_library_modifier
- "unix" (compiler_subdir ["otherlibs"; unixlibdir])
+ "unix" [compiler_subdir ["otherlibs"; unixlibdir]]
let dynlink =
- make_library_modifier "dynlink" (compiler_subdir ["otherlibs"; "dynlink"])
+ make_library_modifier "dynlink"
+ [compiler_subdir ["otherlibs"; "dynlink"];
+ compiler_subdir ["otherlibs"; "dynlink"; "native"]]
let str = make_library_modifier
- "str" (compiler_subdir ["otherlibs"; "str"])
+ "str" [compiler_subdir ["otherlibs"; "str"]]
let systhreads =
unix @
(make_library_modifier
- "threads" (compiler_subdir ["otherlibs"; "systhreads"]))
+ "threads" [compiler_subdir ["otherlibs"; "systhreads"]])
let compilerlibs_subdirs =
[
]
let add_compiler_subdir subdir =
- Append (Ocaml_variables.directories, (wrap (compiler_subdir [subdir])))
+ append Ocaml_variables.directories [compiler_subdir [subdir]]
let compilerlibs_archive archive =
- (Append (Ocaml_variables.libraries, wrap archive)) ::
- (List.map add_compiler_subdir compilerlibs_subdirs)
+ append Ocaml_variables.libraries [archive] ::
+ List.map add_compiler_subdir compilerlibs_subdirs
let debugger = [add_compiler_subdir "debugger"]
setup_ocamlopt_opt_build_env;
ocamlopt_opt;
check_ocamlopt_opt_output;
- compare_native_programs;
] in
{
test_name = "native";
test_run_by_default = true;
test_actions =
- (if Ocamltest_config.arch<>"none" then opt_actions else [skip])
+ (if Ocamltest_config.native_compiler then opt_actions else [skip])
}
let toplevel = {
let asmgen_skip_on_bytecode_only =
Actions_helpers.skip_with_reason "native compiler disabled"
-let asmgen_skip_on_spacetime =
- Actions_helpers.skip_with_reason "not ported to Spacetime yet"
-
let msvc64 =
Ocamltest_config.ccomptype = "msvc" && Ocamltest_config.arch="amd64"
Actions_helpers.skip_with_reason "not ported to MSVC64 yet"
let asmgen_actions =
- if Ocamltest_config.arch="none" then [asmgen_skip_on_bytecode_only]
- else if Ocamltest_config.spacetime then [asmgen_skip_on_spacetime]
+ if not Ocamltest_config.native_compiler then [asmgen_skip_on_bytecode_only]
else if msvc64 then [asmgen_skip_on_msvc64]
else [
setup_simple_build_env;
open Ocamltest_stdlib
class tool
- ~(name : string -> string)
+ ~(name : string)
~(family : string)
~(flags : string)
~(directory : string)
(* Descriptions of the OCaml tools *)
class tool :
- name : (string -> string) ->
+ name : string ->
family : string ->
flags : string ->
directory : string ->
reference_variable : Variables.t ->
output_variable : Variables.t ->
object
- method name : string -> string
+ method name : string
method family : string
method flags : string
method directory : string
open Ocamltest_stdlib
class toplevel
- ~(name : string -> string)
+ ~(name : string)
~(flags : string)
~(directory : string)
~(exit_status_variable : Variables.t)
(* Descriptions of the OCaml toplevels *)
class toplevel :
- name : (string -> string) ->
+ name : string ->
flags : string ->
directory : string ->
exit_status_variable : Variables.t ->
let c_preprocessor = make ("c_preprocessor",
"Command to use to invoke the C preprocessor")
+let cc = make ("cc",
+ "Command to use to invoke the C compiler")
+
let caml_ld_library_path_name = "CAML_LD_LIBRARY_PATH"
let export_caml_ld_library_path value =
val c_preprocessor : Variables.t
+val cc : Variables.t
+
val caml_ld_library_path : Variables.t
val compare_programs : Variables.t
(* The configuration module for ocamltest *)
-let arch = "@@ARCH@@"
+let arch = "%%ARCH%%"
-let afl_instrument = @@AFL_INSTRUMENT@@
+let afl_instrument = %%AFL_INSTRUMENT%%
-let asm = "@@ASM@@"
+let asm = "%%ASM%%"
-let cc = "@@CC@@"
+let cc = "%%CC%%"
-let cflags = "@@CFLAGS@@"
+let cflags = "%%OC_CFLAGS%%"
-let ccomptype = "@@CCOMPTYPE@@"
+let ccomptype = "%%CCOMPTYPE%%"
-let shared_libraries = @@SHARED_LIBRARIES@@
+let shared_libraries = %%SUPPORTS_SHARED_LIBRARIES%%
-let libunix = @@UNIX@@
+let libunix = %%unix%%
-let systhreads = @@SYSTHREADS@@
+let systhreads = %%systhreads%%
-let str = @@STR@@
+let str = %%str%%
-let objext = "@@OBJEXT@@"
+let objext = "%%O%%"
-let asmext = "@@ASMEXT@@"
+let asmext = "%%S%%"
-let system = "@@SYSTEM@@"
+let system = "%%SYSTEM%%"
-let c_preprocessor = "@@CPP@@"
+let c_preprocessor = "%%CPP%%"
-let ocamlsrcdir = "@@OCAMLSRCDIR@@"
+let ocamlsrcdir = "%%ocamlsrcdir%%"
-let flambda = @@FLAMBDA@@
+let flambda = %%FLAMBDA%%
-let spacetime = @@SPACETIME@@
+let ocamlc_default_flags = "%%ocamlcdefaultflags%%"
+let ocamlopt_default_flags = "%%ocamloptdefaultflags%%"
-let ocamlc_default_flags = "@@OCAMLCDEFAULTFLAGS@@"
-let ocamlopt_default_flags = "@@OCAMLOPTDEFAULTFLAGS@@"
+let safe_string = %%FORCE_SAFE_STRING%%
-let safe_string = @@FORCE_SAFE_STRING@@
+let flat_float_array = %%FLAT_FLOAT_ARRAY%%
-let flat_float_array = @@FLAT_FLOAT_ARRAY@@
+let ocamldoc = %%WITH_OCAMLDOC%%
-let ocamldoc = @@OCAMLDOC@@
+let ocamldebug = %%WITH_OCAMLDEBUG%%
-let ocamldebug = @@OCAMLDEBUG@@
+let native_compiler = %%NATIVE_COMPILER%%
-let native_dynlink = @@NATIVE_DYNLINK@@
+let native_dynlink = %%NATDYNLINK%%
-let shared_library_cflags = "@@SHARED_LIBRARY_CFLAGS@@"
+let shared_library_cflags = "%%SHAREDLIB_CFLAGS%%"
-let sharedobjext = "@@SHAREDOBJEXT@@"
+let sharedobjext = "%%SO%%"
-let csc = "@@CSC@@"
+let csc = "%%CSC%%"
-let csc_flags = "@@CSCFLAGS@@"
+let csc_flags = "%%CSCFLAGS%%"
-let mkdll = "@@MKDLL@@"
-let mkexe = "@@MKEXE@@"
+let exe = "%%EXE%%"
-let bytecc_libs = "@@BYTECCLIBS@@"
+let mkdll = "%%MKDLL%%"
+let mkexe = "%%mkexe%%"
-let nativecc_libs = "@@NATIVECCLIBS@@"
+let bytecc_libs = "%%BYTECCLIBS%%"
-let windows_unicode = @@WINDOWS_UNICODE@@ != 0
+let nativecc_libs = "%%NATIVECCLIBS%%"
-let function_sections = @@FUNCTION_SECTIONS@@
+let windows_unicode = %%WINDOWS_UNICODE%% != 0
-let has_instrumented_runtime = @@RUNTIMEI@@
+let function_sections = %%FUNCTION_SECTIONS%%
+
+let has_instrumented_runtime = %%RUNTIMEI%%
+
+let naked_pointers = %%NAKED_POINTERS%%
(* Interface for ocamltest's configuration module *)
val arch : string
-(** Architecture for the native compiler, "none" if it is disabled *)
+(** Architecture for the native compiler *)
val afl_instrument : bool
(** Whether AFL support has been enabled in the compiler *)
val flambda : bool
(** Whether flambda has been enabled at configure time *)
-val spacetime : bool
-(** Whether Spacetime profiling has been enabled at configure time *)
-
val safe_string : bool
(** Whether the compiler was configured with -safe-string *)
val ocamldebug : bool
(** Whether ocamldebug has been enabled at configure time *)
+val native_compiler : bool
+(** Whether the native compiler has been enabled at configure time *)
+
val native_dynlink : bool
(** Whether support for native dynlink is available or not *)
val csc_flags : string
(** Flags for the CSharp compiler *)
+val exe : string
+(** Extension of executable files *)
+
val mkdll : string
val mkexe : string
val has_instrumented_runtime : bool
(** Whether the instrumented runtime is available *)
+
+val naked_pointers : bool
+(** Whether the runtime system supports naked pointers outside the heap *)
(* A few extensions to OCaml's standard library *)
-(* Pervaisive *)
+module Unix = Ocamltest_unix
let input_line_opt ic =
try Some (input_line ic) with End_of_file -> None
module Filename = struct
include Filename
- let path_sep = if Sys.os_type="Win32" then ";" else ":"
+ let path_sep = if Sys.win32 then ";" else ":"
(* This function comes from otherlibs/win32unix/unix.ml *)
let maybe_quote f =
if String.contains f ' ' ||
let make_path components = List.fold_left Filename.concat "" components
- let mkexe =
- if Sys.os_type="Win32"
- then fun name -> make_filename name "exe"
- else fun name -> name
+ let mkexe filename = filename ^ Ocamltest_config.exe
end
module List = struct
module Sys = struct
include Sys
- let file_is_empty filename =
- let ic = open_in filename in
- let filesize = in_channel_length ic in
- close_in ic;
- filesize = 0
-
- let run_system_command command = match Sys.command command with
- | 0 -> ()
- | _ as exitcode ->
- Printf.eprintf "Sysem command %s failed with status %d\n%!"
- command exitcode;
- exit 3
-
- let mkdir dir =
- if not (Sys.file_exists dir) then
- run_system_command (Filename.quote_command "mkdir" [dir])
+ let erase_file path =
+ try Sys.remove path
+ with Sys_error _ when Sys.win32 && Ocamltest_config.libunix <> None ->
+ (* Deal with read-only attribute on Windows. Ignore any error from chmod
+ so that the message always come from Sys.remove *)
+ let () = try Unix.chmod path 0o666 with Sys_error _ -> () in
+ Sys.remove path
+
+ let rm_rf path =
+ let rec erase path =
+ if Sys.is_directory path then begin
+ Array.iter (fun entry -> erase (Filename.concat path entry))
+ (Sys.readdir path);
+ Sys.rmdir path
+ end else erase_file path
+ in
+ try if Sys.file_exists path then erase path
+ with Sys_error err ->
+ raise (Sys_error (Printf.sprintf "Failed to remove %S (%s)" path err))
let rec make_directory dir =
if Sys.file_exists dir then ()
- else (make_directory (Filename.dirname dir); mkdir dir)
+ else let () = make_directory (Filename.dirname dir) in
+ if not (Sys.file_exists dir) then
+ Sys.mkdir dir 0o777
+ else ()
+
+ let make_directory dir =
+ try make_directory dir
+ with Sys_error err ->
+ raise (Sys_error (Printf.sprintf "Failed to create %S (%s)" dir err))
+
+ let with_input_file ?(bin=false) x f =
+ let ic = (if bin then open_in_bin else open_in) x in
+ Fun.protect ~finally:(fun () -> close_in_noerr ic)
+ (fun () -> f ic)
+
+ let file_is_empty filename =
+ not (Sys.file_exists filename) ||
+ with_input_file filename in_channel_length = 0
let string_of_file filename =
- let chan = open_in_bin filename in
+ with_input_file ~bin:true filename @@ fun chan ->
let filesize = in_channel_length chan in
if filesize > Sys.max_string_length then
- begin
- close_in chan;
failwith
("The file " ^ filename ^ " is too large to be loaded into a string")
- end else begin
- let result =
- try really_input_string chan filesize
- with End_of_file ->
- close_in chan;
- failwith ("Got unexpected end of file while reading " ^ filename) in
- close_in chan;
- result
+ else begin
+ try really_input_string chan filesize
+ with End_of_file ->
+ failwith ("Got unexpected end of file while reading " ^ filename)
end
- let with_input_file ?(bin=false) x f =
- let ic = (if bin then open_in_bin else open_in) x in
- try let res = f ic in close_in ic; res with e -> (close_in ic; raise e)
+ let iter_lines_of_file f filename =
+ let rec go ic =
+ match input_line ic with
+ | exception End_of_file -> ()
+ | l -> f l; go ic
+ in
+ with_input_file filename go
+
+ let dump_file oc ?(prefix = "") filename =
+ let f s =
+ output_string oc prefix; output_string oc s; output_char oc '\n' in
+ iter_lines_of_file f filename
let with_output_file ?(bin=false) x f =
let oc = (if bin then open_out_bin else open_out) x in
- try let res = f oc in close_out oc; res with e -> (close_out oc; raise e)
+ Fun.protect ~finally:(fun () -> close_out_noerr oc)
+ (fun () -> f oc)
let copy_chan ic oc =
let m = in_channel_length ic in
in loop ()
let copy_file src dest =
- with_input_file ~bin:true src begin fun ic ->
- with_output_file ~bin:true dest begin fun oc ->
- copy_chan ic oc
- end
- end
+ with_input_file ~bin:true src @@ fun ic ->
+ with_output_file ~bin:true dest @@ fun oc ->
+ copy_chan ic oc
let force_remove file =
if file_exists file then remove file
- external has_symlink : unit -> bool = "caml_has_symlink"
-
let with_chdir path f =
let oldcwd = Sys.getcwd () in
Sys.chdir path;
- match f () with
- | r ->
- Sys.chdir oldcwd;
- r
- | exception e ->
- Sys.chdir oldcwd;
- raise e
+ Fun.protect ~finally:(fun () -> Sys.chdir oldcwd) f
let getenv_with_default_value variable default_value =
try Sys.getenv variable with Not_found -> default_value
let safe_getenv variable = getenv_with_default_value variable ""
end
+
+module Seq = struct
+ include Seq
+
+ let rec equal s1 s2 =
+ match s1 (), s2 () with
+ | Nil, Nil -> true
+ | Cons(e1, s1), Cons(e2, s2) -> e1 = e2 && equal s1 s2
+ | _, _ -> false
+end
module Sys : sig
include module type of Sys
val file_is_empty : string -> bool
- val run_system_command : string -> unit
val make_directory : string -> unit
+ val rm_rf : string -> unit
val string_of_file : string -> string
+ val iter_lines_of_file : (string -> unit) -> string -> unit
+ val dump_file : out_channel -> ?prefix:string -> string -> unit
val copy_chan : in_channel -> out_channel -> unit
val copy_file : string -> string -> unit
val force_remove : string -> unit
- val has_symlink : unit -> bool
val with_chdir : string -> (unit -> 'a) -> 'a
val getenv_with_default_value : string -> string -> string
val safe_getenv : string -> string
+ val with_input_file : ?bin:bool -> string -> (in_channel -> 'a) -> 'a
+ val with_output_file : ?bin:bool -> string -> (out_channel -> 'a) -> 'a
+end
+
+module Seq : sig
+ include module type of struct include Seq end
+
+ val equal : 'a t -> 'a t -> bool
+end
+
+module Unix : sig
+ include module type of Ocamltest_unix
end
+++ /dev/null
-/**************************************************************************/
-/* */
-/* OCaml */
-/* */
-/* Sebastien Hinderer, projet Gallium, INRIA Paris */
-/* */
-/* Copyright 2018 Institut National de Recherche en Informatique et */
-/* en Automatique. */
-/* */
-/* All rights reserved. This file is distributed under the terms of */
-/* the GNU Lesser General Public License version 2.1, with the */
-/* special exception on linking described in the file LICENSE. */
-/* */
-/**************************************************************************/
-
-/* Stubs for ocamltest's standard library */
-
-#include <stdio.h>
-#include <stdlib.h>
-
-#include <caml/config.h>
-#include <caml/mlvalues.h>
-#include <caml/memory.h>
-#include <caml/alloc.h>
-/*
-#include <caml/fail.h>
-*/
-#include <caml/signals.h>
-#include <caml/osdeps.h>
-
-
-#ifdef _WIN32
-
-/*
- * Windows Vista functions enabled
- */
-#undef _WIN32_WINNT
-#define _WIN32_WINNT 0x0600
-
-#include <wtypes.h>
-#include <winbase.h>
-#include <process.h>
-#include <sys/types.h>
-
-#define luid_eq(l, r) (l.LowPart == r.LowPart && l.HighPart == r.HighPart)
-
-CAMLprim value caml_has_symlink(value unit)
-{
- CAMLparam1(unit);
- HANDLE hProcess = GetCurrentProcess();
- BOOL result = FALSE;
-
- if (OpenProcessToken(hProcess, TOKEN_READ, &hProcess)) {
- LUID seCreateSymbolicLinkPrivilege;
-
- if (LookupPrivilegeValue(NULL,
- SE_CREATE_SYMBOLIC_LINK_NAME,
- &seCreateSymbolicLinkPrivilege)) {
- DWORD length;
-
- if (!GetTokenInformation(hProcess, TokenPrivileges, NULL, 0, &length)) {
- if (GetLastError() == ERROR_INSUFFICIENT_BUFFER) {
- TOKEN_PRIVILEGES* privileges =
- (TOKEN_PRIVILEGES*)caml_stat_alloc(length);
- if (GetTokenInformation(hProcess,
- TokenPrivileges,
- privileges,
- length,
- &length)) {
- DWORD count = privileges->PrivilegeCount;
-
- if (count) {
- LUID_AND_ATTRIBUTES* privs = privileges->Privileges;
- while (count-- &&
- !(result = luid_eq(privs->Luid,
- seCreateSymbolicLinkPrivilege)))
- privs++;
- }
- }
-
- caml_stat_free(privileges);
- }
- }
- }
-
- CloseHandle(hProcess);
- }
-
- CAMLreturn(Val_bool(result));
-}
-
-
-#else /* _WIN32 */
-
-#ifdef HAS_SYMLINK
-
-CAMLprim value caml_has_symlink(value unit)
-{
- CAMLparam0();
- CAMLreturn(Val_true);
-}
-
-#else /* HAS_SYMLINK */
-
-CAMLprim value unix_symlink(value to_dir, value path1, value path2)
-{ caml_invalid_argument("symlink not implemented"); }
-
-CAMLprim value caml_has_symlink(value unit)
-{
- CAMLparam0();
- CAMLreturn(Val_false);
-}
-
-#endif
-
-#endif /* _WIN32 */
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* David Allsopp, OCaml Labs, Cambridge. *)
+(* *)
+(* Copyright 2020 David Allsopp Ltd. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(** Functions imported from Unix. They are explicitly here to remove the
+ temptation to use the Unix module directly in ocamltest. *)
+
+val has_symlink : unit -> bool
+val symlink : ?to_dir:bool -> string -> string -> unit
+val chmod : string -> int -> unit
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* David Allsopp, OCaml Labs, Cambridge. *)
+(* *)
+(* Copyright 2020 David Allsopp Ltd. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(* Dummy implementations for when the Unix library isn't built *)
+let has_symlink () = false
+let symlink ?to_dir:_ _ _ = invalid_arg "symlink not available"
+let chmod _ _ = invalid_arg "chmod not available"
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* David Allsopp, OCaml Labs, Cambridge. *)
+(* *)
+(* Copyright 2020 David Allsopp Ltd. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(* Unix.has_symlink never raises *)
+let has_symlink = Unix.has_symlink
+
+(* Convert Unix_error to Sys_error *)
+let wrap f x =
+ try f x
+ with Unix.Unix_error(err, fn_name, arg) ->
+ let msg =
+ Printf.sprintf "%s failed on %S with %s"
+ fn_name arg (Unix.error_message err)
+ in
+ raise (Sys_error msg)
+
+let symlink ?to_dir source = wrap (Unix.symlink ?to_dir source)
+let chmod file = wrap (Unix.chmod file)
let usage = "Usage: " ^ Sys.argv.(0) ^ " options files to test"
-let _ =
+let () =
Arg.parse (Arg.align commandline_options) (add_to_list files_to_test) usage
+
+let log_to_stderr = !log_to_stderr
+let files_to_test = !files_to_test
+let promote = !promote
+let find_test_dirs = !find_test_dirs
+let list_tests = !list_tests
+let keep_test_dir_on_success = !keep_test_dir_on_success
(* Description of ocamltest's command-line options *)
-val log_to_stderr : bool ref
+val log_to_stderr : bool
-val files_to_test : string list ref
+val files_to_test : string list
-val promote : bool ref
+val promote : bool
val usage : string
-val find_test_dirs : string list ref
+val find_test_dirs : string list
-val list_tests : string list ref
+val list_tests : string list
-val keep_test_dir_on_success : bool ref
+val keep_test_dir_on_success : bool
let settings_of_commandline ?(stdout_fname="") ?(stderr_fname="") commandline =
let words = String.words commandline in
let quoted_words =
- if Sys.os_type="Win32"
+ if Sys.win32
then List.map Filename.maybe_quote words
else words in
{
if (text == NULL) return;
if (vsnprintf(text, length, fmt, ap) != length) goto end;
}
+ Lock(channel);
caml_putblock(channel, text, length);
caml_flush(channel);
+ Unlock(channel);
end:
free(text);
}
memcpy(value, pos_eq + 1, value_length);
value[value_length] = '\0';
setenv(name, value, 1); /* 1 means overwrite */
+ free(name);
+ free(value);
}
}
}
| [] -> (Result.pass, env)
| action::remaining_actions ->
begin
- Printf.fprintf log "Running action %d/%d (%s)\n%!"
+ Printf.fprintf log "\nRunning action %d/%d (%s)\n%!"
action_number total (Actions.name action);
let (result, env') = Actions.run log env action in
Printf.fprintf log "Action %d/%d (%s) %s\n%!"
| "*/" { TSL_END_C_STYLE }
| "(*" blank* "TEST" { TSL_BEGIN_OCAML_STYLE }
| "*)" { TSL_END_OCAML_STYLE }
- | "," { COMA }
+ | "," { COMMA }
| '*'+ { TEST_DEPTH (String.length (Lexing.lexeme lexbuf)) }
| "+=" { PLUSEQUAL }
| "=" { EQUAL }
%token TSL_BEGIN_C_STYLE TSL_END_C_STYLE
%token TSL_BEGIN_OCAML_STYLE TSL_END_OCAML_STYLE
-%token COMA
+%token COMMA
%token <int> TEST_DEPTH
%token EQUAL PLUSEQUAL
/* %token COLON */
opt_environment_modifiers:
| { [] }
-| opt_environment_modifiers COMA identifier { $3::$1 }
+| opt_environment_modifiers COMMA identifier { $3::$1 }
env_item:
| identifier EQUAL string
#**************************************************************************
ROOTDIR=..
--include $(ROOTDIR)/Makefile.config
--include $(ROOTDIR)/Makefile.common
+include $(ROOTDIR)/Makefile.common
-OTHERLIBRARIES ?= bigarray dynlink raw_spacetime_lib str systhreads \
+OTHERLIBRARIES ?= bigarray dynlink str systhreads \
unix win32unix
# $1: target name to dispatch to all otherlibs/*/Makefile
# Common Makefile for otherlibs
ROOTDIR=../..
--include $(ROOTDIR)/Makefile.config
--include $(ROOTDIR)/Makefile.common
+include $(ROOTDIR)/Makefile.common
include $(ROOTDIR)/Makefile.best_binaries
CAMLRUN ?= $(ROOTDIR)/boot/ocamlrun
CAMLC := $(BEST_OCAMLC) -nostdlib -I $(ROOTDIR)/stdlib
CAMLOPT := $(BEST_OCAMLOPT) -nostdlib -I $(ROOTDIR)/stdlib
+ifneq "$(CCOMPTYPE)" "msvc"
+OC_CFLAGS += -g
+endif
+
OC_CFLAGS += $(SHAREDLIB_CFLAGS) $(EXTRACFLAGS)
-OC_CPPFLAGS += -I$(ROOTDIR)/runtime
+OC_CPPFLAGS += -I$(ROOTDIR)/runtime $(EXTRACPPFLAGS)
# Compilation options
COMPFLAGS=-absname -w +a-4-9-41-42-44-45-48 -warn-error A -bin-annot -g \
# but have sensible default values:
COBJS ?=
EXTRACFLAGS ?=
+EXTRACPPFLAGS ?=
EXTRACAMLFLAGS ?=
LINKOPTS ?=
LDOPTS ?=
install::
if test -f dll$(CLIBNAME)$(EXT_DLL); then \
$(INSTALL_PROG) \
- dll$(CLIBNAME)$(EXT_DLL) \
- "$(INSTALL_STUBLIBDIR)/"; \
+ dll$(CLIBNAME)$(EXT_DLL) "$(INSTALL_STUBLIBDIR)"; \
fi
ifneq "$(STUBSLIB)" ""
$(INSTALL_DATA) $(STUBSLIB) "$(INSTALL_LIBDIR)/"
"$(INSTALL_LIBDIR)/"
cd "$(INSTALL_LIBDIR)"; $(RANLIB) $(LIBNAME).a
if test -f $(LIBNAME).cmxs; then \
- $(INSTALL_PROG) $(LIBNAME).cmxs "$(INSTALL_LIBDIR)/"; \
+ $(INSTALL_PROG) $(LIBNAME).cmxs "$(INSTALL_LIBDIR)"; \
fi
partialclean:
clean:: partialclean
rm -f *.dll *.so *.a *.lib *.o *.obj
+ rm -rf $(DEPDIR)
-.SUFFIXES: .ml .mli .cmi .cmo .cmx .$(O)
+.SUFFIXES: .ml .mli .cmi .cmo .cmx
.mli.cmi:
$(CAMLC) -c $(COMPFLAGS) $<
.ml.cmx:
$(CAMLOPT) -c $(COMPFLAGS) $(OPTCOMPFLAGS) $<
-.c.$(O):
- $(CC) -c $(OC_CFLAGS) $(OC_CPPFLAGS) $(OUTPUTOBJ)$@ $<
+ifeq "$(COMPUTE_DEPS)" "true"
+ifneq "$(COBJS)" ""
+include $(addprefix $(DEPDIR)/, $(COBJS:.$(O)=.$(D)))
+endif
+endif
+
+$(DEPDIR)/%.$(D): %.c | $(DEPDIR)
+ $(DEP_CC) $(OC_CPPFLAGS) $(CPPFLAGS) $< -MT '$*.$(O)' -MF $@
ROOTDIR = ../..
--include $(ROOTDIR)/Makefile.config
--include $(ROOTDIR)/Makefile.common
+include $(ROOTDIR)/Makefile.common
include $(ROOTDIR)/Makefile.best_binaries
-CAMLRUN ?= $(ROOTDIR)/boot/ocamlrun
+CAMLRUN ?= $(ROOTDIR)/boot/ocamlrun$(EXE)
OCAMLC=$(BEST_OCAMLC) -g -nostdlib -I $(ROOTDIR)/stdlib
OCAMLOPT=$(BEST_OCAMLOPT) -g -nostdlib -I $(ROOTDIR)/stdlib
# .ml files from compilerlibs that have corresponding .mli files.
COMPILERLIBS_SOURCES=\
+ utils/binutils.ml \
utils/config.ml \
utils/build_path_prefix_map.ml \
utils/misc.ml \
utils/consistbl.ml \
utils/terminfo.ml \
utils/warnings.ml \
+ utils/local_store.ml \
utils/load_path.ml \
utils/int_replace_polymorphic_compare.ml \
parsing/location.ml \
# The main dynlink rules start here.
-all: dynlink.cma extract_crc
+extract_crc := extract_crc$(EXE)
+
+all: dynlink.cma $(extract_crc)
allopt: dynlink.cmxa
dynlink_platform_intf.mli: dynlink_platform_intf.ml
cp $< $@
-extract_crc: dynlink.cma byte/dynlink_compilerlibs.cmo extract_crc.cmo
+$(eval $(call PROGRAM_SYNONYM,extract_crc))
+
+$(extract_crc): dynlink.cma byte/dynlink_compilerlibs.cmo extract_crc.cmo
$(OCAMLC) -o $@ $^
install:
dynlink.cmti dynlink.mli \
"$(INSTALL_LIBDIR)"
endif
- $(INSTALL_PROG) \
- extract_crc "$(INSTALL_LIBDIR)/extract_crc$(EXE)"
+ $(INSTALL_PROG) $(extract_crc) "$(INSTALL_LIBDIR)"
installopt:
if $(NATDYNLINK); then \
fi
partialclean:
- rm -f extract_crc *.cm[ioaxt] *.cmti *.cmxa \
+ rm -f $(extract_crc) *.cm[ioaxt] *.cmti *.cmxa \
byte/*.cm[iot] byte/*.cmti \
native/*.cm[ixt] native/*.cmti native/*.o native/*.obj \
$(LOCAL_SRC)/*.cm[ioaxt] $(LOCAL_SRC)/*.cmti \
$(LOCAL_SRC)/*.o $(LOCAL_SRC)/*.obj
clean: partialclean
+ rm -f extract_crc extract_crc.exe
rm -f *.a *.lib *.o *.obj *.so *.dll dynlink_platform_intf.mli \
$(LOCAL_SRC)/*.ml $(LOCAL_SRC)/*.mli $(LOCAL_SRC)/Makefile \
$(LOCAL_SRC)/.depend byte/dynlink.mli native/dynlink.mli
beforedepend: dynlink_platform_intf.mli
.PHONY: depend
-ifeq "$(TOOLCHAIN)" "msvc"
-depend:
- $(error Dependencies cannot be regenerated using the MSVC ports)
-else
DEPEND_DUMMY_FILES=\
native/dynlink_compilerlibs.ml \
byte/dynlink_compilerlibs.mli \
$(CAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash \
-I native -native *.ml native/dynlink.ml >> .depend
rm -f $(DEPEND_DUMMY_FILES)
-endif
include .depend
-.SUFFIXES: .ml .mli .cmi .cmo .cmx .$(O)
+.SUFFIXES: .ml .mli .cmi .cmo .cmx
.mli.cmi:
$(OCAMLC) -c $(COMPFLAGS) $<
global_state := state
let main_program_units () =
+ init ();
String.Set.elements (!global_state).main_program_units
let public_dynamically_loaded_units () =
+ init ();
String.Set.elements (!global_state).public_dynamically_loaded_units
let all_units () =
+ init ();
String.Set.elements (String.Set.union
(!global_state).main_program_units
(!global_state).public_dynamically_loaded_units)
+++ /dev/null
-spacetime_offline.$(O): spacetime_offline.c ../../runtime/caml/alloc.h \
- ../../runtime/caml/misc.h ../../runtime/caml/config.h \
- ../../runtime/caml/m.h ../../runtime/caml/s.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/domain_state.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/config.h \
- ../../runtime/caml/fail.h ../../runtime/caml/gc.h \
- ../../runtime/caml/intext.h ../../runtime/caml/io.h \
- ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/major_gc.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
- ../../runtime/caml/minor_gc.h ../../runtime/caml/misc.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/roots.h \
- ../../runtime/caml/memory.h ../../runtime/caml/signals.h \
- ../../runtime/caml/stack.h ../../runtime/caml/sys.h \
- ../../runtime/caml/spacetime.h ../../runtime/caml/stack.h \
- ../../runtime/caml/s.h
-raw_spacetime_lib.cmo : \
- raw_spacetime_lib.cmi
-raw_spacetime_lib.cmx : \
- raw_spacetime_lib.cmi
-raw_spacetime_lib.cmi :
+++ /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. *
-#* *
-#**************************************************************************
-
-# Makefile for Raw_spacetime_lib
-
-LIBNAME=raw_spacetime_lib
-COBJS=spacetime_offline.$(O)
-CAMLOBJS=raw_spacetime_lib.cmo
-
-include ../Makefile.otherlibs.common
-
-.PHONY: depend
-depend:
-ifeq "$(TOOLCHAIN)" "msvc"
- $(error Dependencies cannot be regenerated using the MSVC ports)
-else
- $(CC) -MM $(OC_CPPFLAGS) *.c | sed -e 's/\.o/.$$(O)/g' > .depend
- $(CAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash *.mli *.ml >> .depend
-endif
-
-include .depend
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Mark Shinwell and Leo White, Jane Street Europe *)
-(* *)
-(* Copyright 2015--2017 Jane Street Group LLC *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-module Gc_stats : sig
- type t
-
- val minor_words : t -> int
- val promoted_words : t -> int
- val major_words : t -> int
- val minor_collections : t -> int
- val major_collections : t -> int
- val heap_words : t -> int
- val heap_chunks : t -> int
- val compactions : t -> int
- val top_heap_words : t -> int
-end = struct
- type t = {
- minor_words : int;
- promoted_words : int;
- major_words : int;
- minor_collections : int;
- major_collections : int;
- heap_words : int;
- heap_chunks : int;
- compactions : int;
- top_heap_words : int;
- }
-
- let minor_words t = t.minor_words
- let promoted_words t = t.promoted_words
- let major_words t = t.major_words
- let minor_collections t = t.minor_collections
- let major_collections t = t.major_collections
- let heap_words t = t.heap_words
- let heap_chunks t = t.heap_chunks
- let compactions t = t.compactions
- let top_heap_words t = t.top_heap_words
-end
-
-module Program_counter = struct
- module OCaml = struct
- type t = Int64.t
-
- let to_int64 t = t
- end
-
- module Foreign = struct
- type t = Int64.t
-
- let to_int64 t = t
- end
-end
-
-module Function_identifier = struct
- type t = Int64.t
-
- let to_int64 t = t
-end
-
-module Function_entry_point = struct
- type t = Int64.t
-
- let to_int64 t = t
-end
-
-module Int64_map = Map.Make (Int64)
-
-module Frame_table = struct
- type raw = (Int64.t * (Printexc.Slot.t list)) list
-
- type t = Printexc.Slot.t list Int64_map.t
-
- let demarshal chn : t =
- let raw : raw = Marshal.from_channel chn in
- List.fold_left (fun map (pc, rev_location_list) ->
- Int64_map.add pc (List.rev rev_location_list) map)
- Int64_map.empty
- raw
-
- let find_exn = Int64_map.find
-end
-
-module Shape_table = struct
- type part_of_shape =
- | Direct_call of { call_site : Int64.t; callee : Int64.t; }
- | Indirect_call of Int64.t
- | Allocation_point of Int64.t
-
- let _ = Direct_call { call_site = 0L; callee = 0L; }
- let _ = Indirect_call 0L
- let _ = Allocation_point 0L
-
- type raw = (Int64.t * (part_of_shape list)) list
-
- type t = {
- shapes : part_of_shape list Int64_map.t;
- call_counts : bool;
- }
-
- let part_of_shape_size t = function
- | Direct_call _ -> if t.call_counts then 2 else 1
- | Indirect_call _ -> 1
- | Allocation_point _ -> 3
-
- let demarshal chn ~call_counts : t =
- let raw : raw = Marshal.from_channel chn in
- let shapes =
- List.fold_left (fun map (key, data) -> Int64_map.add key data map)
- Int64_map.empty
- raw
- in
- { shapes;
- call_counts;
- }
-
- let find_exn func_id t = Int64_map.find func_id t.shapes
- let call_counts t = t.call_counts
-end
-
-module Annotation = struct
- type t = int
-
- let to_int t = t
-end
-
-module Trace = struct
- type node
- type ocaml_node
- type foreign_node
- type uninstrumented_node
-
- type t = node option
- type trace = t
-
- (* This function unmarshals into malloc blocks, which mean that we
- obtain a straightforward means of writing [compare] on [node]s. *)
- external unmarshal : in_channel -> 'a
- = "caml_spacetime_unmarshal_trie"
-
- let unmarshal in_channel =
- let trace = unmarshal in_channel in
- if trace = () then
- None
- else
- Some ((Obj.magic trace) : node)
-
- let foreign_node_is_null (node : foreign_node) =
- ((Obj.magic node) : unit) == ()
-
- external node_num_header_words : unit -> int
- = "caml_spacetime_node_num_header_words" [@@noalloc]
-
- let num_header_words = lazy (node_num_header_words ())
-
- module OCaml = struct
- type field_iterator = {
- node : ocaml_node;
- offset : int;
- part_of_shape : Shape_table.part_of_shape;
- remaining_layout : Shape_table.part_of_shape list;
- shape_table : Shape_table.t;
- }
-
- module Allocation_point = struct
- type t = field_iterator
-
- let program_counter t =
- match t.part_of_shape with
- | Shape_table.Allocation_point call_site -> call_site
- | _ -> assert false
-
- external annotation : ocaml_node -> int -> Annotation.t
- = "caml_spacetime_ocaml_allocation_point_annotation"
- [@@noalloc]
-
- let annotation t = annotation t.node t.offset
-
- external count : ocaml_node -> int -> int
- = "caml_spacetime_ocaml_allocation_point_count"
- [@@noalloc]
-
- let num_words_including_headers t = count t.node t.offset
- end
-
- module Direct_call_point = struct
- type _ t = field_iterator
-
- let call_site t =
- match t.part_of_shape with
- | Shape_table.Direct_call { call_site; _ } -> call_site
- | _ -> assert false
-
- let callee t =
- match t.part_of_shape with
- | Shape_table.Direct_call { callee; _ } -> callee
- | _ -> assert false
-
- external callee_node : ocaml_node -> int -> 'target
- = "caml_spacetime_ocaml_direct_call_point_callee_node"
-
- let callee_node (type target) (t : target t) : target =
- callee_node t.node t.offset
-
- external call_count : ocaml_node -> int -> int
- = "caml_spacetime_ocaml_direct_call_point_call_count"
-
- let call_count t =
- if Shape_table.call_counts t.shape_table then
- Some (call_count t.node t.offset)
- else
- None
- end
-
- module Indirect_call_point = struct
- type t = field_iterator
-
- let call_site t =
- match t.part_of_shape with
- | Shape_table.Indirect_call call_site -> call_site
- | _ -> assert false
-
- module Callee = struct
- (* CR-soon mshinwell: we should think about the names again. This is
- a "c_node" but it isn't foreign. *)
- type t = {
- node : foreign_node;
- call_counts : bool;
- }
-
- let is_null t = foreign_node_is_null t.node
-
- (* CR-soon mshinwell: maybe rename ...c_node_call_site -> c_node_pc,
- since it isn't a call site in this case. *)
- external callee : foreign_node -> Function_entry_point.t
- = "caml_spacetime_c_node_call_site"
-
- let callee t = callee t.node
-
- (* This can return a node satisfying "is_null" in the case of an
- uninitialised tail call point. See the comment in the C code. *)
- external callee_node : foreign_node -> node
- = "caml_spacetime_c_node_callee_node" [@@noalloc]
-
- let callee_node t = callee_node t.node
-
- external call_count : foreign_node -> int
- = "caml_spacetime_c_node_call_count"
-
- let call_count t =
- if t.call_counts then Some (call_count t.node)
- else None
-
- external next : foreign_node -> foreign_node
- = "caml_spacetime_c_node_next" [@@noalloc]
-
- let next t =
- let next = { t with node = next t.node; } in
- if foreign_node_is_null next.node then None
- else Some next
- end
-
- external callees : ocaml_node -> int -> foreign_node
- = "caml_spacetime_ocaml_indirect_call_point_callees"
- [@@noalloc]
-
- let callees t =
- let callees =
- { Callee.
- node = callees t.node t.offset;
- call_counts = Shape_table.call_counts t.shape_table;
- }
- in
- if Callee.is_null callees then None
- else Some callees
- end
-
- module Field = struct
- type t = field_iterator
-
- type direct_call_point =
- | To_ocaml of ocaml_node Direct_call_point.t
- | To_foreign of foreign_node Direct_call_point.t
- | To_uninstrumented of
- uninstrumented_node Direct_call_point.t
-
- type classification =
- | Allocation of Allocation_point.t
- | Direct_call of direct_call_point
- | Indirect_call of Indirect_call_point.t
-
- external classify_direct_call_point : ocaml_node -> int -> int
- = "caml_spacetime_classify_direct_call_point"
- [@@noalloc]
-
- let classify t =
- match t.part_of_shape with
- | Shape_table.Direct_call _callee ->
- let direct_call_point =
- match classify_direct_call_point t.node t.offset with
- | 0 ->
- (* We should never classify uninitialised call points here. *)
- assert false
- | 1 -> To_ocaml t
- | 2 -> To_foreign t
- | _ -> assert false
- in
- Direct_call direct_call_point
- | Shape_table.Indirect_call _ -> Indirect_call t
- | Shape_table.Allocation_point _ -> Allocation t
-
- (* CR-soon mshinwell: change to "is_unused"? *)
- let is_uninitialised t =
- let offset_to_node_hole =
- match t.part_of_shape with
- | Shape_table.Direct_call _ -> Some 0
- | Shape_table.Indirect_call _ -> Some 0
- | Shape_table.Allocation_point _ -> None
- in
- match offset_to_node_hole with
- | None -> false
- | Some offset_to_node_hole ->
- (* There are actually two cases:
- 1. A normal unused node hole, which says Val_unit;
- 2. An unused tail call point. This will contain a pointer to the
- start of the current node, but it also has the bottom bit
- set. *)
- let offset = t.offset + offset_to_node_hole in
- Obj.is_int (Obj.field (Obj.repr t.node) offset)
-
- let rec next t =
- match t.remaining_layout with
- | [] -> None
- | part_of_shape::remaining_layout ->
- let size =
- Shape_table.part_of_shape_size t.shape_table t.part_of_shape
- in
- let offset = t.offset + size in
- assert (offset < Obj.size (Obj.repr t.node));
- let t =
- { node = t.node;
- offset;
- part_of_shape;
- remaining_layout;
- shape_table = t.shape_table;
- }
- in
- skip_uninitialised t
-
- and skip_uninitialised t =
- if not (is_uninitialised t) then Some t
- else next t
- end
-
- module Node = struct
- type t = ocaml_node
-
- external function_identifier : t -> Function_identifier.t
- = "caml_spacetime_ocaml_function_identifier"
-
- external next_in_tail_call_chain : t -> t
- = "caml_spacetime_ocaml_tail_chain" [@@noalloc]
-
- external compare : t -> t -> int
- = "caml_spacetime_compare_node" [@@noalloc]
-
- let fields t ~shape_table =
- let id = function_identifier t in
- match Shape_table.find_exn id shape_table with
- | exception Not_found -> None
- | [] -> None
- | part_of_shape::remaining_layout ->
- let t =
- { node = t;
- offset = Lazy.force num_header_words;
- part_of_shape;
- remaining_layout;
- shape_table;
- }
- in
- Field.skip_uninitialised t
- end
- end
-
- module Foreign = struct
- module Node = struct
- type t = foreign_node
-
- external compare : t -> t -> int
- = "caml_spacetime_compare_node" [@@noalloc]
-
- let fields t =
- if foreign_node_is_null t then None
- else Some t
- end
-
- module Allocation_point = struct
- type t = foreign_node
-
- external program_counter : t -> Program_counter.Foreign.t
- (* This is not a mistake; the same C function works. *)
- = "caml_spacetime_c_node_call_site"
-
- external annotation : t -> Annotation.t
- = "caml_spacetime_c_node_profinfo" [@@noalloc]
-
- external num_words_including_headers : t -> int
- = "caml_spacetime_c_node_allocation_count" [@@noalloc]
- end
-
- module Call_point = struct
- type t = foreign_node
-
- external call_site : t -> Program_counter.Foreign.t
- = "caml_spacetime_c_node_call_site"
-
- (* May return a null node. See comment above and the C code. *)
- external callee_node : t -> node
- = "caml_spacetime_c_node_callee_node" [@@noalloc]
- end
-
- module Field = struct
- type t = foreign_node
-
- type classification =
- | Allocation of Allocation_point.t
- | Call of Call_point.t
-
- external is_call : t -> bool
- = "caml_spacetime_c_node_is_call" [@@noalloc]
-
- let classify t =
- if is_call t then Call t
- else Allocation t
-
- external next : t -> t
- = "caml_spacetime_c_node_next" [@@noalloc]
-
- let next t =
- let next = next t in
- if foreign_node_is_null next then None
- else Some next
- end
- end
-
- module Node = struct
- module T = struct
- type t = node
-
- external compare : t -> t -> int
- = "caml_spacetime_compare_node" [@@noalloc]
- end
-
- include T
-
- type classification =
- | OCaml of OCaml.Node.t
- | Foreign of Foreign.Node.t
-
- external is_ocaml_node : t -> bool
- = "caml_spacetime_is_ocaml_node" [@@noalloc]
-
- let classify t =
- if is_ocaml_node t then OCaml ((Obj.magic t) : ocaml_node)
- else Foreign ((Obj.magic t) : foreign_node)
-
- let of_ocaml_node (node : ocaml_node) : t = Obj.magic node
- let of_foreign_node (node : foreign_node) : t = Obj.magic node
-
- module Map = Map.Make (T)
- module Set = Set.Make (T)
- end
-
- let root t = t
-end
-
-module Heap_snapshot = struct
-
- module Entries = struct
- type t = int array (* == "struct snapshot_entries" *)
-
- let length t =
- let length = Array.length t in
- assert (length mod 3 = 0);
- length / 3
-
- let annotation t idx = t.(idx*3)
- let num_blocks t idx = t.(idx*3 + 1)
- let num_words_including_headers t idx = t.(idx*3 + 2)
- end
-
- type total_allocations =
- | End
- | Total of {
- annotation : Annotation.t;
- count : int;
- next : total_allocations;
- }
-
- let (_ : total_allocations) = (* suppress compiler warning *)
- Total { annotation = 0; count = 0; next = End; }
-
- type t = {
- timestamp : float;
- gc_stats : Gc_stats.t;
- entries : Entries.t;
- words_scanned : int;
- words_scanned_with_profinfo : int;
- total_allocations : total_allocations;
- }
-
- type heap_snapshot = t
-
- let timestamp t = t.timestamp
- let gc_stats t = t.gc_stats
- let entries t = t.entries
- let words_scanned t = t.words_scanned
- let words_scanned_with_profinfo t = t.words_scanned_with_profinfo
-
- module Total_allocation = struct
- type t = total_allocations (* [End] is forbidden *)
-
- let annotation = function
- | End -> assert false
- | Total { annotation; _ } -> annotation
-
- let num_words_including_headers = function
- | End -> assert false
- | Total { count; _ } -> count
-
- let next = function
- | End -> assert false
- | Total { next = End; _ } -> None
- | Total { next; _ } -> Some next
- end
-
- let total_allocations t =
- match t.total_allocations with
- | End -> None
- | (Total _) as totals -> Some totals
-
- module Event = struct
- type t = {
- event_name : string;
- time : float;
- }
-
- let event_name t = t.event_name
- let timestamp t = t.time
- end
-
- module Series = struct
- type t = {
- num_snapshots : int;
- time_of_writer_close : float;
- frame_table : Frame_table.t;
- shape_table : Shape_table.t;
- traces_by_thread : Trace.t array;
- finaliser_traces_by_thread : Trace.t array;
- snapshots : heap_snapshot array;
- events : Event.t list;
- call_counts : bool;
- }
-
- (* The order of these constructors must match the C code. *)
- type what_comes_next =
- | Snapshot
- | Traces
- | Event
-
- (* Suppress compiler warning 37. *)
- let _ : what_comes_next list = [Snapshot; Traces; Event;]
-
- let rec read_snapshots_and_events chn snapshots events =
- let next : what_comes_next = Marshal.from_channel chn in
- match next with
- | Snapshot ->
- let snapshot : heap_snapshot = Marshal.from_channel chn in
- read_snapshots_and_events chn (snapshot :: snapshots) events
- | Event ->
- let event_name : string = Marshal.from_channel chn in
- let time : float = Marshal.from_channel chn in
- let event = { Event. event_name; time; } in
- read_snapshots_and_events chn snapshots (event :: events)
- | Traces ->
- (Array.of_list (List.rev snapshots)), List.rev events
-
- let read ~path =
- let chn = open_in_bin path in
- let magic_number : int = Marshal.from_channel chn in
- let magic_number_base = magic_number land 0xffff_ffff in
- let version_number = (magic_number lsr 32) land 0xffff in
- let features = (magic_number lsr 48) land 0xffff in
- if magic_number_base <> 0xace00ace then begin
- failwith "Raw_spacetime_lib: not a Spacetime profiling file"
- end else begin
- match version_number with
- | 0 ->
- let call_counts =
- match features with
- | 0 -> false
- | 1 -> true
- | _ ->
- failwith "Raw_spacetime_lib: unknown Spacetime profiling file \
- feature set"
- in
- let snapshots, events = read_snapshots_and_events chn [] [] in
- let num_snapshots = Array.length snapshots in
- let time_of_writer_close : float = Marshal.from_channel chn in
- let frame_table = Frame_table.demarshal chn in
- let shape_table = Shape_table.demarshal chn ~call_counts in
- let num_threads : int = Marshal.from_channel chn in
- let traces_by_thread = Array.init num_threads (fun _ -> None) in
- let finaliser_traces_by_thread =
- Array.init num_threads (fun _ -> None)
- in
- for thread = 0 to num_threads - 1 do
- let trace : Trace.t = Trace.unmarshal chn in
- let finaliser_trace : Trace.t = Trace.unmarshal chn in
- traces_by_thread.(thread) <- trace;
- finaliser_traces_by_thread.(thread) <- finaliser_trace
- done;
- close_in chn;
- { num_snapshots;
- time_of_writer_close;
- frame_table;
- shape_table;
- traces_by_thread;
- finaliser_traces_by_thread;
- snapshots;
- events;
- call_counts;
- }
- | _ ->
- failwith "Raw_spacetime_lib: unknown Spacetime profiling file \
- version number"
- end
-
- type trace_kind = Normal | Finaliser
-
- let num_threads t = Array.length t.traces_by_thread
-
- let trace t ~kind ~thread_index =
- if thread_index < 0 || thread_index >= num_threads t then None
- else
- match kind with
- | Normal -> Some t.traces_by_thread.(thread_index)
- | Finaliser -> Some t.finaliser_traces_by_thread.(thread_index)
-
- let num_snapshots t = t.num_snapshots
- let snapshot t ~index = t.snapshots.(index)
- let frame_table t = t.frame_table
- let shape_table t = t.shape_table
- let time_of_writer_close t = t.time_of_writer_close
- let events t = t.events
- let has_call_counts t = t.call_counts
- end
-end
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Mark Shinwell and Leo White, Jane Street Europe *)
-(* *)
-(* Copyright 2015--2017 Jane Street Group LLC *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-(** Access to the information recorded by the [Spacetime]
- module. (It is intended that this module will be used by
- post-processors rather than users wishing to understand their
- programs.)
- For 64-bit targets only.
- This module may be used from any program, not just one compiled
- with a compiler configured for Spacetime. *)
-
-module Gc_stats : sig
- type t
-
- val minor_words : t -> int
- val promoted_words : t -> int
- val major_words : t -> int
- val minor_collections : t -> int
- val major_collections : t -> int
- val heap_words : t -> int
- val heap_chunks : t -> int
- val compactions : t -> int
- val top_heap_words : t -> int
-end
-
-module Annotation : sig
- (** An annotation written into a value's header. These may be looked up
- in a [Trace.t] (see below). *)
- type t
-
- (* CR-someday mshinwell: consider using tag and size to increase the
- available space of annotations. Need to be careful of [Obj.truncate].
- Could also randomise the tags on records.
- *)
-
- val to_int : t -> int
-end
-
-module Program_counter : sig
- module OCaml : sig
- type t
-
- val to_int64 : t -> Int64.t
- end
-
- module Foreign : sig
- type t
-
- val to_int64 : t -> Int64.t
- end
-
-end
-
-module Frame_table : sig
- (* CR-someday mshinwell: move to [Gc] if dependencies permit? *)
- (** A value of type [t] corresponds to the frame table of a running
- OCaml program. The table is indexed by program counter address
- (typically, but not always when using Spacetime, return addresses). *)
- type t
-
- (** Find the location, including any inlined frames, corresponding to the
- given program counter address. Raises [Not_found] if the location
- could not be resolved. *)
- val find_exn : Program_counter.OCaml.t -> t -> Printexc.Slot.t list
-end
-
-module Function_entry_point : sig
- type t
-
- val to_int64 : t -> Int64.t
-end
-
-module Function_identifier : sig
- type t
- (* CR-soon mshinwell: same as [Function_entry_point] now *)
- val to_int64 : t -> Int64.t
-end
-
-module Shape_table : sig
- type t
-end
-
-module Trace : sig
- (** A value of type [t] holds the dynamic call structure of the program
- (i.e. which functions have called which other functions) together with
- information required to decode profiling annotations written into
- values' headers. *)
- type t
- type trace = t
-
- type node
- type ocaml_node
- type foreign_node
- type uninstrumented_node
-
- module OCaml : sig
- module Allocation_point : sig
- (** A value of type [t] corresponds to an allocation point in OCaml
- code. *)
- type t
-
- (** The program counter at (or close to) the allocation site. *)
- val program_counter : t -> Program_counter.OCaml.t
-
- (** The annotation written into the headers of boxed values allocated
- at the given allocation site. *)
- val annotation : t -> Annotation.t
-
- (** The total number of words allocated at this point. *)
- val num_words_including_headers : t -> int
- end
-
- module Direct_call_point : sig
- (** A value of type ['target t] corresponds to a direct (i.e. known
- at compile time) call point in OCaml code. ['target] is the type
- of the node corresponding to the callee. *)
- type 'target t
-
- (** The program counter at (or close to) the call site. *)
- val call_site : _ t -> Program_counter.OCaml.t
-
- (** The address of the first instruction of the callee. *)
- val callee : _ t -> Function_entry_point.t
-
- (** The node corresponding to the callee. *)
- val callee_node : 'target t -> 'target
-
- (** The number of times the callee was called. Only available if the
- compiler that recorded the Spacetime profile was configured with
- "-with-spacetime-call-counts". [None] will be returned otherwise. *)
- val call_count : _ t -> int option
- end
-
- module Indirect_call_point : sig
- (** A value of type [t] corresponds to an indirect call point in OCaml
- code. Each such value contains a list of callees to which the
- call point has branched. *)
- type t
-
- (** The program counter at (or close to) the call site. *)
- val call_site : t -> Program_counter.OCaml.t
-
- module Callee : sig
- type t
-
- (** The address of the first instruction of the callee. *)
- val callee : t -> Function_entry_point.t
-
- (** The node corresponding to the callee. *)
- val callee_node : t -> node
-
- (** The number of times the callee was called. This returns [None] in
- the same circumstances as [Direct_call_point.call_count], above. *)
- val call_count : t -> int option
-
- (** Move to the next callee to which this call point has branched.
- [None] is returned when the end of the list is reached. *)
- val next : t -> t option
- end
-
- (** The list of callees to which this indirect call point has
- branched. *)
- val callees : t -> Callee.t option
- end
-
- module Field : sig
- (** A value of type [t] enables iteration through the contents
- ("fields") of an OCaml node. *)
- type t
-
- type direct_call_point =
- | To_ocaml of ocaml_node Direct_call_point.t
- | To_foreign of foreign_node Direct_call_point.t
- (* CR-soon mshinwell: once everything's finished, "uninstrumented"
- should be able to go away. Let's try to do this after the
- first release. *)
- | To_uninstrumented of
- uninstrumented_node Direct_call_point.t
-
- type classification =
- | Allocation of Allocation_point.t
- | Direct_call of direct_call_point
- | Indirect_call of Indirect_call_point.t
-
- val classify : t -> classification
- val next : t -> t option
- end
-
- module Node : sig
- (** A node corresponding to an invocation of a function written in
- OCaml. *)
- type t = ocaml_node
-
- val compare : t -> t -> int
-
- (** A unique identifier for the function corresponding to this node. *)
- val function_identifier : t -> Function_identifier.t
-
- (** This function traverses a circular list. *)
- val next_in_tail_call_chain : t -> t
-
- val fields : t -> shape_table:Shape_table.t -> Field.t option
- end
- end
-
- module Foreign : sig
- module Allocation_point : sig
- (** A value of type [t] corresponds to an allocation point in non-OCaml
- code. *)
- type t
-
- val program_counter : t -> Program_counter.Foreign.t
- val annotation : t -> Annotation.t
- val num_words_including_headers : t -> int
- end
-
- module Call_point : sig
- (** A value of type [t] corresponds to a call point from non-OCaml
- code (to either non-OCaml code, or OCaml code via the usual
- assembly veneer). Call counts are not available for such nodes. *)
- type t
-
- (** N.B. The address of the callee (of type [Function_entry_point.t]) is
- not available. It must be recovered during post-processing. *)
- val call_site : t -> Program_counter.Foreign.t
- val callee_node : t -> node
- end
-
- module Field : sig
- (** A value of type [t] enables iteration through the contents ("fields")
- of a C node. *)
- type t
-
- type classification = private
- | Allocation of Allocation_point.t
- | Call of Call_point.t
-
- val classify : t -> classification
- val next : t -> t option
- end
-
- module Node : sig
- (** A node corresponding to an invocation of a function written in C
- (or any other language that is not OCaml). *)
- type t = foreign_node
-
- val compare : t -> t -> int
-
- val fields : t -> Field.t option
-
- end
-
- end
-
- module Node : sig
- (** Either an OCaml or a foreign node; or an indication that this
- is a branch of the graph corresponding to uninstrumented
- code. *)
- type t = node
-
- val compare : t -> t -> int
-
- type classification = private
- | OCaml of OCaml.Node.t
- | Foreign of Foreign.Node.t
-
- val classify : t -> classification
-
- val of_ocaml_node : OCaml.Node.t -> t
- val of_foreign_node : Foreign.Node.t -> t
-
- module Set : Set.S with type elt = t
- module Map : Map.S with type key = t
- end
-
- (** Obtains the root of the graph for traversal. [None] is returned if
- the graph is empty. *)
- val root : t -> Node.t option
-end
-
-module Heap_snapshot : sig
- type t
- type heap_snapshot = t
-
- module Entries : sig
- (** An immutable array of the total number of blocks (= boxed
- values) and the total number of words occupied by such blocks
- (including their headers) for each profiling annotation in
- the heap. *)
- type t
-
- val length : t -> int
- val annotation : t -> int -> Annotation.t
- val num_blocks : t -> int -> int
- val num_words_including_headers : t -> int -> int
-
- end
-
- (** The timestamp of a snapshot. The units are as for [Sys.time]
- (unless custom timestamps are being provided, cf. the [Spacetime] module
- in the standard library). *)
- val timestamp : t -> float
-
- val gc_stats : t -> Gc_stats.t
- val entries : t -> Entries.t
- val words_scanned : t -> int
- val words_scanned_with_profinfo : t -> int
-
- module Total_allocation : sig
- type t
-
- val annotation : t -> Annotation.t
- val num_words_including_headers : t -> int
- val next : t -> t option
- end
-
- (** Total allocations across *all threads*. *)
- (* CR-someday mshinwell: change the relevant variables to be thread-local *)
- val total_allocations : t -> Total_allocation.t option
-
- module Event : sig
- type t
-
- val event_name : t -> string
- val timestamp : t -> float
- end
-
- module Series : sig
- type t
-
- (** At present, the [Trace.t] associated with a [Series.t] cannot be
- garbage collected or freed. This should not be a problem, since
- the intention is that a post-processor reads the trace and outputs
- another format. *)
- val read : path:string -> t
-
- val time_of_writer_close : t -> float
- val num_threads : t -> int
-
- type trace_kind = Normal | Finaliser
- val trace : t -> kind:trace_kind -> thread_index:int -> Trace.t option
-
- val frame_table : t -> Frame_table.t
- val shape_table : t -> Shape_table.t
- val num_snapshots : t -> int
- val snapshot : t -> index:int -> heap_snapshot
- val events : t -> Event.t list
-
- (** Returns [true] iff call count information was recorded in the
- series. *)
- val has_call_counts : t -> bool
- end
-end
+++ /dev/null
-/**************************************************************************/
-/* */
-/* OCaml */
-/* */
-/* Mark Shinwell and Leo White, Jane Street Europe */
-/* */
-/* Copyright 2013--2016, Jane Street Group, LLC */
-/* */
-/* All rights reserved. This file is distributed under the terms of */
-/* the GNU Lesser General Public License version 2.1, with the */
-/* special exception on linking described in the file LICENSE. */
-/* */
-/**************************************************************************/
-
-#define CAML_INTERNALS
-
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <limits.h>
-#include <math.h>
-
-#include "caml/alloc.h"
-#include "caml/config.h"
-#include "caml/fail.h"
-#include "caml/gc.h"
-#include "caml/intext.h"
-#include "caml/major_gc.h"
-#include "caml/memory.h"
-#include "caml/minor_gc.h"
-#include "caml/misc.h"
-#include "caml/mlvalues.h"
-#include "caml/roots.h"
-#include "caml/signals.h"
-#include "caml/stack.h"
-#include "caml/sys.h"
-#include "caml/spacetime.h"
-
-#include "caml/s.h"
-
-#define SPACETIME_PROFINFO_WIDTH 26
-#define Spacetime_profinfo_hd(hd) \
- (Gen_profinfo_hd(SPACETIME_PROFINFO_WIDTH, hd))
-
-#ifdef ARCH_SIXTYFOUR
-
-/* CR-someday lwhite: The following two definitions are copied from spacetime.c
- because they are needed here, but must be inlined in spacetime.c
- for performance. Perhaps a macro or "static inline" would be
- more appropriate. */
-
-c_node* caml_spacetime_offline_c_node_of_stored_pointer_not_null
- (value node_stored)
-{
- CAMLassert(Is_c_node(node_stored));
- return (c_node*) Hp_val(node_stored);
-}
-
-c_node_type caml_spacetime_offline_classify_c_node(c_node* node)
-{
- return (node->pc & 2) ? CALL : ALLOCATION;
-}
-
-CAMLprim value caml_spacetime_compare_node(
- value node1, value node2)
-{
- CAMLassert(!Is_in_value_area(node1));
- CAMLassert(!Is_in_value_area(node2));
-
- if (node1 == node2) {
- return Val_long(0);
- }
- if (node1 < node2) {
- return Val_long(-1);
- }
- return Val_long(1);
-}
-
-CAMLprim value caml_spacetime_unmarshal_trie (value v_channel)
-{
- return caml_input_value_to_outside_heap(v_channel);
-}
-
-CAMLprim value caml_spacetime_node_num_header_words(value unit)
-{
- return Val_long(Node_num_header_words);
-}
-
-CAMLprim value caml_spacetime_is_ocaml_node(value node)
-{
- CAMLassert(Is_ocaml_node(node) || Is_c_node(node));
- return Val_bool(Is_ocaml_node(node));
-}
-
-CAMLprim value caml_spacetime_ocaml_function_identifier(value node)
-{
- CAMLassert(Is_ocaml_node(node));
- return caml_copy_int64((uint64_t) Decode_node_pc(Node_pc(node)));
-}
-
-CAMLprim value caml_spacetime_ocaml_tail_chain(value node)
-{
- CAMLassert(Is_ocaml_node(node));
- return Tail_link(node);
-}
-
-CAMLprim value caml_spacetime_classify_direct_call_point
- (value node, value offset)
-{
- uintnat field;
- value callee_node;
-
- CAMLassert(Is_ocaml_node(node));
-
- field = Long_val(offset);
-
- callee_node = Direct_callee_node(node, field);
- if (!Is_block(callee_node)) {
- /* An unused call point (may be a tail call point). */
- return Val_long(0);
- } else if (Is_ocaml_node(callee_node)) {
- return Val_long(1); /* direct call point to OCaml code */
- } else {
- return Val_long(2); /* direct call point to non-OCaml code */
- }
-}
-
-CAMLprim value caml_spacetime_ocaml_allocation_point_annotation
- (value node, value offset)
-{
- uintnat profinfo_shifted;
- profinfo_shifted = (uintnat) Alloc_point_profinfo(node, Long_val(offset));
- return Val_long(Spacetime_profinfo_hd(profinfo_shifted));
-}
-
-CAMLprim value caml_spacetime_ocaml_allocation_point_count
- (value node, value offset)
-{
- value count = Alloc_point_count(node, Long_val(offset));
- CAMLassert(!Is_block(count));
- return count;
-}
-
-CAMLprim value caml_spacetime_ocaml_direct_call_point_callee_node
- (value node, value offset)
-{
- return Direct_callee_node(node, Long_val(offset));
-}
-
-CAMLprim value caml_spacetime_ocaml_direct_call_point_call_count
-(value node, value offset)
-{
- return Direct_call_count(node, Long_val(offset));
-}
-
-CAMLprim value caml_spacetime_ocaml_indirect_call_point_callees
- (value node, value offset)
-{
- value callees = Indirect_pc_linked_list(node, Long_val(offset));
- CAMLassert(Is_block(callees));
- CAMLassert(Is_c_node(callees));
- return callees;
-}
-
-CAMLprim value caml_spacetime_c_node_is_call(value node)
-{
- c_node* c_node;
- CAMLassert(node != (value) NULL);
- CAMLassert(Is_c_node(node));
- c_node = caml_spacetime_offline_c_node_of_stored_pointer_not_null(node);
- switch (caml_spacetime_offline_classify_c_node(c_node)) {
- case CALL: return Val_true;
- case ALLOCATION: return Val_false;
- }
- CAMLassert(0);
- return Val_unit; /* silence compiler warning */
-}
-
-CAMLprim value caml_spacetime_c_node_next(value node)
-{
- c_node* c_node;
-
- CAMLassert(node != (value) NULL);
- CAMLassert(Is_c_node(node));
- c_node = caml_spacetime_offline_c_node_of_stored_pointer_not_null(node);
- CAMLassert(c_node->next == Val_unit || Is_c_node(c_node->next));
- return c_node->next;
-}
-
-CAMLprim value caml_spacetime_c_node_call_site(value node)
-{
- c_node* c_node;
- CAMLassert(node != (value) NULL);
- CAMLassert(Is_c_node(node));
- c_node = caml_spacetime_offline_c_node_of_stored_pointer_not_null(node);
- return caml_copy_int64((uint64_t) Decode_c_node_pc(c_node->pc));
-}
-
-CAMLprim value caml_spacetime_c_node_callee_node(value node)
-{
- c_node* c_node;
- CAMLassert(node != (value) NULL);
- CAMLassert(Is_c_node(node));
- c_node = caml_spacetime_offline_c_node_of_stored_pointer_not_null(node);
- CAMLassert(caml_spacetime_offline_classify_c_node(c_node) == CALL);
- /* This might be an uninitialised tail call point: for example if an OCaml
- callee was indirectly called but the callee wasn't instrumented (e.g. a
- leaf function that doesn't allocate). */
- if (Is_tail_caller_node_encoded(c_node->data.call.callee_node)) {
- return Val_unit;
- }
- return c_node->data.call.callee_node;
-}
-
-CAMLprim value caml_spacetime_c_node_call_count(value node)
-{
- c_node* c_node;
- CAMLassert(node != (value) NULL);
- CAMLassert(Is_c_node(node));
- c_node = caml_spacetime_offline_c_node_of_stored_pointer_not_null(node);
- CAMLassert(caml_spacetime_offline_classify_c_node(c_node) == CALL);
- if (Is_tail_caller_node_encoded(c_node->data.call.callee_node)) {
- return Val_long(0);
- }
- return c_node->data.call.call_count;
-}
-
-CAMLprim value caml_spacetime_c_node_profinfo(value node)
-{
- c_node* c_node;
- CAMLassert(node != (value) NULL);
- CAMLassert(Is_c_node(node));
- c_node = caml_spacetime_offline_c_node_of_stored_pointer_not_null(node);
- CAMLassert(caml_spacetime_offline_classify_c_node(c_node) == ALLOCATION);
- CAMLassert(!Is_block(c_node->data.allocation.profinfo));
- return Val_long(Spacetime_profinfo_hd(c_node->data.allocation.profinfo));
-}
-
-CAMLprim value caml_spacetime_c_node_allocation_count(value node)
-{
- c_node* c_node;
- CAMLassert(node != (value) NULL);
- CAMLassert(Is_c_node(node));
- c_node = caml_spacetime_offline_c_node_of_stored_pointer_not_null(node);
- CAMLassert(caml_spacetime_offline_classify_c_node(c_node) == ALLOCATION);
- CAMLassert(!Is_block(c_node->data.allocation.count));
- return c_node->data.allocation.count;
-}
-
-#endif
-strstubs.$(O): strstubs.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/domain.h \
- ../../runtime/caml/fail.h
str.cmo : \
str.cmi
str.cmx : \
.PHONY: depend
depend:
-ifeq "$(TOOLCHAIN)" "msvc"
- $(error Dependencies cannot be regenerated using the MSVC ports)
-else
- $(CC) -MM $(OC_CPPFLAGS) *.c | sed -e 's/\.o/.$$(O)/g' > .depend
- $(CAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash *.mli *.ml >> .depend
-endif
+ $(CAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash *.mli *.ml > .depend
include .depend
-st_stubs_b.$(O): st_stubs.c ../../runtime/caml/alloc.h \
- ../../runtime/caml/misc.h ../../runtime/caml/config.h \
- ../../runtime/caml/m.h ../../runtime/caml/s.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/domain_state.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/backtrace.h \
- ../../runtime/caml/exec.h ../../runtime/caml/callback.h \
- ../../runtime/caml/custom.h ../../runtime/caml/domain.h \
- ../../runtime/caml/fail.h ../../runtime/caml/io.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
- ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
- ../../runtime/caml/domain.h ../../runtime/caml/misc.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/printexc.h \
- ../../runtime/caml/roots.h ../../runtime/caml/memory.h \
- ../../runtime/caml/signals.h ../../runtime/caml/stacks.h \
- ../../runtime/caml/sys.h ../../runtime/caml/memprof.h \
- ../../runtime/caml/roots.h threads.h
-st_stubs_n.$(O): st_stubs.c ../../runtime/caml/alloc.h \
- ../../runtime/caml/misc.h ../../runtime/caml/config.h \
- ../../runtime/caml/m.h ../../runtime/caml/s.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/domain_state.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/backtrace.h \
- ../../runtime/caml/exec.h ../../runtime/caml/callback.h \
- ../../runtime/caml/custom.h ../../runtime/caml/domain.h \
- ../../runtime/caml/fail.h ../../runtime/caml/io.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
- ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
- ../../runtime/caml/domain.h ../../runtime/caml/misc.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/printexc.h \
- ../../runtime/caml/roots.h ../../runtime/caml/memory.h \
- ../../runtime/caml/signals.h ../../runtime/caml/stack.h \
- ../../runtime/caml/sys.h ../../runtime/caml/memprof.h \
- ../../runtime/caml/roots.h threads.h
condition.cmo : \
mutex.cmi \
condition.cmi
mutex.cmx : \
mutex.cmi
mutex.cmi :
+semaphore.cmo : \
+ mutex.cmi \
+ condition.cmi \
+ semaphore.cmi
+semaphore.cmx : \
+ mutex.cmx \
+ condition.cmx \
+ semaphore.cmi
+semaphore.cmi :
thread.cmo : \
thread.cmi
thread.cmx : \
ROOTDIR=../..
--include $(ROOTDIR)/Makefile.config
--include $(ROOTDIR)/Makefile.common
+include $(ROOTDIR)/Makefile.common
include $(ROOTDIR)/Makefile.best_binaries
-OC_CFLAGS += $(SHAREDLIB_CFLAGS)
+ifneq "$(CCOMPTYPE)" "msvc"
+OC_CFLAGS += -g
+endif
+
+OC_CFLAGS += $(SHAREDLIB_CFLAGS) $(PTHREAD_CFLAGS)
OC_CPPFLAGS += -I$(ROOTDIR)/runtime
CAMLC=$(BEST_OCAMLC) $(LIBS)
CAMLOPT=$(BEST_OCAMLOPT) $(LIBS)
-MKLIB=$(CAMLRUN) $(ROOTDIR)/tools/ocamlmklib
+MKLIB=$(CAMLRUN) $(ROOTDIR)/tools/ocamlmklib$(EXE)
COMPFLAGS=-w +33..39 -warn-error A -g -bin-annot -safe-string
ifeq "$(FLAMBDA)" "true"
OPTCOMPFLAGS += -O3
LIBNAME=threads
-ifeq "$(UNIX_OR_WIN32)" "unix"
-HEADER = st_posix.h
-else # Windows
-HEADER = st_win32.h
-endif
-
# Note: the header on which object files produced from st_stubs.c
# should actually depend is known for sure only at compile-time.
# That's why this dependency is handled in the Makefile directly
# and removed from the output of the C compiler during make depend
-BYTECODE_C_OBJS=st_stubs_b.$(O)
-NATIVECODE_C_OBJS=st_stubs_n.$(O)
+BYTECODE_C_OBJS=st_stubs.b.$(O)
+NATIVECODE_C_OBJS=st_stubs.n.$(O)
-THREADS_SOURCES = thread.ml mutex.ml condition.ml event.ml threadUnix.ml
+THREADS_SOURCES = thread.ml mutex.ml condition.ml event.ml threadUnix.ml \
+ semaphore.ml
THREADS_BCOBJS = $(THREADS_SOURCES:.ml=.cmo)
THREADS_NCOBJS = $(THREADS_SOURCES:.ml=.cmx)
-MLIFILES=thread.mli mutex.mli condition.mli event.mli threadUnix.mli
+MLIFILES=thread.mli mutex.mli condition.mli event.mli threadUnix.mli \
+ semaphore.mli
+
CMIFILES=$(MLIFILES:.mli=.cmi)
all: lib$(LIBNAME).$(A) $(LIBNAME).cma $(CMIFILES)
# which itself will pass -lunix to the C linker. It seems more
# modular to me this way. -- Alain
-# The following lines produce two object files st_stubs_b.$(O) and
-# st_stubs_n.$(O) from the same source file st_stubs.c (it is compiled
+# The following lines produce two object files st_stubs.b.$(O) and
+# st_stubs.n.$(O) from the same source file st_stubs.c (it is compiled
# twice, each time with different options).
-st_stubs_n.$(O): OC_CPPFLAGS += $(NATIVE_CPPFLAGS)
-
-st_stubs_b.$(O): st_stubs.c $(HEADER)
- $(CC) -c $(OC_CFLAGS) $(OC_CPPFLAGS) $(OUTPUTOBJ)$@ $<
+st_stubs.n.$(O): OC_CPPFLAGS += $(NATIVE_CPPFLAGS)
-st_stubs_n.$(O): st_stubs.c $(HEADER)
- $(CC) -c $(OC_CFLAGS) $(OC_CPPFLAGS) $(OUTPUTOBJ)$@ $<
+ifneq "$(COMPUTE_DEPS)" "false"
+st_stubs.%.$(O): st_stubs.c
+else
+st_stubs.%.$(O): st_stubs.c $(RUNTIME_HEADERS) $(wildcard *.h)
+endif
+ $(CC) -c $(OC_CFLAGS) $(CFLAGS) $(OC_CPPFLAGS) $(CPPFLAGS) \
+ $(OUTPUTOBJ)$@ $<
partialclean:
rm -f *.cm*
clean: partialclean
rm -f dllthreads*.so dllthreads*.dll *.a *.lib *.o *.obj
+ rm -rf $(DEPDIR)
INSTALL_THREADSLIBDIR=$(INSTALL_LIBDIR)/$(LIBNAME)
install:
if test -f dllthreads$(EXT_DLL); then \
- $(INSTALL_PROG) \
- dllthreads$(EXT_DLL) "$(INSTALL_STUBLIBDIR)/dllthreads$(EXT_DLL)"; \
+ $(INSTALL_PROG) dllthreads$(EXT_DLL) "$(INSTALL_STUBLIBDIR)"; \
fi
$(INSTALL_DATA) libthreads.$(A) "$(INSTALL_LIBDIR)"
cd "$(INSTALL_LIBDIR)"; $(RANLIB) libthreads.$(A)
.ml.cmx:
$(CAMLOPT) -c $(COMPFLAGS) $(OPTCOMPFLAGS) $<
+DEP_FILES := st_stubs.b.$(D)
+ifneq "$(NATIVE_COMPILER)" "false"
+DEP_FILES += st_stubs.n.$(D)
+endif
+
+ifeq "$(COMPUTE_DEPS)" "true"
+include $(addprefix $(DEPDIR)/, $(DEP_FILES))
+endif
+
+%.n.$(O): OC_CPPFLAGS += $(NATIVE_CPPFLAGS)
+%.n.$(D): OC_CPPFLAGS += $(NATIVE_CPPFLAGS)
+
+define GEN_RULE
+$(DEPDIR)/%.$(1).$(D): %.c | $(DEPDIR)
+ $$(DEP_CC) $$(OC_CPPFLAGS) $$(CPPFLAGS) $$< -MT '$$*.$(1).$(O)' -MF $$@
+endef
+
+$(foreach object_type, b n, $(eval $(call GEN_RULE,$(object_type))))
+
.PHONY: depend
-ifeq "$(TOOLCHAIN)" "msvc"
depend:
- $(error Dependencies cannot be regenerated using the MSVC ports)
-else
-depend:
- $(CC) -MM $(OC_CPPFLAGS) st_stubs.c \
- | sed -e 's/st_stubs\.o/st_stubs_b.$$(O)/' \
- -e 's/ st_\(posix\|win32\)\.h//g' > .depend
- $(CC) -MM $(OC_CPPFLAGS) $(NATIVE_CPPFLAGS) \
- st_stubs.c | sed -e 's/st_stubs\.o/st_stubs_n.$$(O)/' \
- -e 's/ st_\(posix\|win32\)\.h//g' >> .depend
- $(CAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash *.mli *.ml >> .depend
-endif
+ $(CAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash *.mli *.ml > .depend
include .depend
(** Lock the given mutex. Only one thread can have the mutex locked
at any time. A thread that attempts to lock a mutex already locked
by another thread will suspend until the other thread unlocks
- the mutex. *)
+ the mutex.
+
+ @raise Sys_error if the mutex is already locked by the thread calling
+ {!Mutex.lock}.
+
+ @before 4.12 {!Sys_error} was not raised for recursive locking
+ (platform-dependent behaviour) *)
val try_lock : t -> bool
(** Same as {!Mutex.lock}, but does not suspend the calling thread if
val unlock : t -> unit
(** Unlock the given mutex. Other threads suspended trying to lock
- the mutex will restart. *)
+ the mutex will restart. The mutex must have been previously locked
+ by the thread that calls {!Mutex.unlock}.
+ @raise Sys_error if the mutex is unlocked or was locked by another thread.
+
+ @before 4.12 {!Sys_error} was not raised when unlocking an unlocked mutex
+ or when unlocking a mutex from a different thread. *)
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, Collège de France and 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. *)
+(* *)
+(**************************************************************************)
+
+(** Semaphores *)
+
+type sem = {
+ mut: Mutex.t; (* protects [v] *)
+ mutable v: int; (* the current value *)
+ nonzero: Condition.t (* signaled when [v > 0] *)
+}
+
+module Counting = struct
+
+type t = sem
+
+let make v =
+ if v < 0 then invalid_arg "Semaphore.Counting.init: wrong initial value";
+ { mut = Mutex.create(); v; nonzero = Condition.create() }
+
+let release s =
+ Mutex.lock s.mut;
+ if s.v < max_int then begin
+ s.v <- s.v + 1;
+ Condition.signal s.nonzero;
+ Mutex.unlock s.mut
+ end else begin
+ Mutex.unlock s.mut;
+ raise (Sys_error "Semaphore.Counting.release: overflow")
+ end
+
+let acquire s =
+ Mutex.lock s.mut;
+ while s.v = 0 do Condition.wait s.nonzero s.mut done;
+ s.v <- s.v - 1;
+ Mutex.unlock s.mut
+
+let try_acquire s =
+ Mutex.lock s.mut;
+ let ret = if s.v = 0 then false else (s.v <- s.v - 1; true) in
+ Mutex.unlock s.mut;
+ ret
+
+let get_value s = s.v
+
+end
+
+module Binary = struct
+
+type t = sem
+
+let make b =
+ { mut = Mutex.create();
+ v = if b then 1 else 0;
+ nonzero = Condition.create() }
+
+let release s =
+ Mutex.lock s.mut;
+ s.v <- 1;
+ Condition.signal s.nonzero;
+ Mutex.unlock s.mut
+
+let acquire s =
+ Mutex.lock s.mut;
+ while s.v = 0 do Condition.wait s.nonzero s.mut done;
+ s.v <- 0;
+ Mutex.unlock s.mut
+
+let try_acquire s =
+ Mutex.lock s.mut;
+ let ret = if s.v = 0 then false else (s.v <- 0; true) in
+ Mutex.unlock s.mut;
+ ret
+
+end
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, Collège de France and 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. *)
+(* *)
+(**************************************************************************)
+
+(** Semaphores
+
+ A semaphore is a thread synchronization device that can be used to
+ control access to a shared resource.
+
+ Two flavors of semaphores are provided: counting semaphores and
+ binary semaphores.
+
+ @since 4.12 *)
+
+(** {2 Counting semaphores} *)
+
+(**
+ A counting semaphore is a counter that can be accessed concurrently
+ by several threads. The typical use is to synchronize producers and
+ consumers of a resource by counting how many units of the resource
+ are available.
+
+ The two basic operations on semaphores are:
+- "release" (also called "V", "post", "up", and "signal"), which
+ increments the value of the counter. This corresponds to producing
+ one more unit of the shared resource and making it available to others.
+- "acquire" (also called "P", "wait", "down", and "pend"), which
+ waits until the counter is greater than zero and decrements it.
+ This corresponds to consuming one unit of the shared resource.
+
+ @since 4.12 *)
+
+module Counting : sig
+
+type t
+(** The type of counting semaphores. *)
+
+val make : int -> t
+(** [make n] returns a new counting semaphore, with initial value [n].
+ The initial value [n] must be nonnegative.
+
+ @raise Invalid_argument if [n < 0]
+*)
+
+val release : t -> unit
+(** [release s] increments the value of semaphore [s].
+ If other threads are waiting on [s], one of them is restarted.
+ If the current value of [s] is equal to [max_int], the value of
+ the semaphore is unchanged and a [Sys_error] exception is raised
+ to signal overflow.
+
+ @raise Sys_error if the value of the semaphore would overflow [max_int]
+*)
+
+val acquire : t -> unit
+(** [acquire s] blocks the calling thread until the value of semaphore [s]
+ is not zero, then atomically decrements the value of [s] and returns.
+*)
+
+val try_acquire : t -> bool
+(** [try_acquire s] immediately returns [false] if the value of semaphore [s]
+ is zero. Otherwise, the value of [s] is atomically decremented
+ and [try_acquire s] returns [true].
+*)
+
+val get_value : t -> int
+(** [get_value s] returns the current value of semaphore [s].
+ The current value can be modified at any time by concurrent
+ {!release} and {!acquire} operations. Hence, the [get_value]
+ operation is racy, and its result should only be used for debugging
+ or informational messages.
+*)
+
+end
+
+(** {2 Binary semaphores} *)
+
+(** Binary semaphores are a variant of counting semaphores
+ where semaphores can only take two values, 0 and 1.
+
+ A binary semaphore can be used to control access to a single
+ shared resource, with value 1 meaning "resource is available" and
+ value 0 meaning "resource is unavailable".
+
+ The "release" operation of a binary semaphore sets its value to 1,
+ and "acquire" waits until the value is 1 and sets it to 0.
+
+ A binary semaphore can be used instead of a mutex (see module
+ {!Mutex}) when the mutex discipline (of unlocking the mutex from the
+ thread that locked it) is too restrictive. The "acquire" operation
+ corresponds to locking the mutex, and the "release" operation to
+ unlocking it, but "release" can be performed in a thread different
+ than the one that performed the "acquire". Likewise, it is safe
+ to release a binary semaphore that is already available.
+
+ @since 4.12
+*)
+
+module Binary : sig
+
+type t
+(** The type of binary semaphores. *)
+
+val make : bool -> t
+(** [make b] returns a new binary semaphore.
+ If [b] is [true], the initial value of the semaphore is 1, meaning
+ "available". If [b] is [false], the initial value of the
+ semaphore is 0, meaning "unavailable".
+*)
+
+val release : t -> unit
+(** [release s] sets the value of semaphore [s] to 1, putting it in the
+ "available" state. If other threads are waiting on [s], one of them is
+ restarted.
+*)
+
+val acquire : t -> unit
+(** [acquire s] blocks the calling thread until the semaphore [s]
+ has value 1 (is available), then atomically sets it to 0
+ and returns.
+*)
+
+val try_acquire : t -> bool
+(** [try_acquire s] immediately returns [false] if the semaphore [s]
+ has value 0. If [s] has value 1, its value is atomically set to 0
+ and [try_acquire s] returns [true].
+*)
+
+end
#include <stdio.h>
#include <stdlib.h>
#include <pthread.h>
-#ifdef __sun
-#define _POSIX_PTHREAD_SEMANTICS
-#endif
#include <signal.h>
#include <time.h>
#include <sys/time.h>
pthread_setspecific(k, v);
}
+/* Windows-specific hook. */
+Caml_inline void st_thread_set_id(intnat id)
+{
+ return;
+}
+
/* The master lock. This is a mutex that is held most of the time,
so we implement it in a slightly convoluted way to avoid
all risks of busy-waiting. Also, we count the number of waiting
static int st_mutex_create(st_mutex * res)
{
int rc;
- st_mutex m = caml_stat_alloc_noexc(sizeof(pthread_mutex_t));
- if (m == NULL) return ENOMEM;
- rc = pthread_mutex_init(m, NULL);
- if (rc != 0) { caml_stat_free(m); return rc; }
+ pthread_mutexattr_t attr;
+ st_mutex m;
+
+ rc = pthread_mutexattr_init(&attr);
+ if (rc != 0) goto error1;
+ rc = pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_ERRORCHECK);
+ if (rc != 0) goto error2;
+ m = caml_stat_alloc_noexc(sizeof(pthread_mutex_t));
+ if (m == NULL) { rc = ENOMEM; goto error2; }
+ rc = pthread_mutex_init(m, &attr);
+ if (rc != 0) goto error3;
+ pthread_mutexattr_destroy(&attr);
*res = m;
return 0;
+error3:
+ caml_stat_free(m);
+error2:
+ pthread_mutexattr_destroy(&attr);
+error1:
+ return rc;
}
static int st_mutex_destroy(st_mutex m)
return rc;
}
+#define MUTEX_DEADLOCK EDEADLK
+
Caml_inline int st_mutex_lock(st_mutex m)
{
return pthread_mutex_lock(m);
}
-#define PREVIOUSLY_UNLOCKED 0
-#define ALREADY_LOCKED EBUSY
+#define MUTEX_PREVIOUSLY_UNLOCKED 0
+#define MUTEX_ALREADY_LOCKED EBUSY
Caml_inline int st_mutex_trylock(st_mutex m)
{
return pthread_mutex_trylock(m);
}
+#define MUTEX_NOT_OWNED EPERM
+
Caml_inline int st_mutex_unlock(st_mutex m)
{
return pthread_mutex_unlock(m);
retcode = pthread_sigmask(how, &set, &oldset);
caml_leave_blocking_section();
st_check_error(retcode, "Thread.sigmask");
+ /* Run any handlers for just-unmasked pending signals */
+ caml_process_pending_actions();
return st_encode_sigset(&oldset);
}
#endif
#include "caml/sys.h"
#include "caml/memprof.h"
-#include "threads.h"
-#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
-#include "caml/spacetime.h"
-#endif
+/* threads.h is *not* included since it contains the _external_ declarations for
+ the caml_c_thread_register and caml_c_thread_unregister functions. */
#ifndef NATIVE_CODE
/* Initial size of bytecode stack when a thread is created (4 Ko) */
char * exception_pointer; /* Saved value of Caml_state->exception_pointer */
struct caml__roots_block * local_roots; /* Saved value of local_roots */
struct longjmp_buffer * exit_buf; /* For thread exit */
-#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
- value internal_spacetime_trie_root;
- value internal_spacetime_finaliser_trie_root;
- value* spacetime_trie_node_ptr;
- value* spacetime_finaliser_trie_root;
-#endif
#else
value * stack_low; /* The execution stack for this thread */
value * stack_high;
int backtrace_pos; /* Saved Caml_state->backtrace_pos */
backtrace_slot * backtrace_buffer; /* Saved Caml_state->backtrace_buffer */
value backtrace_last_exn; /* Saved Caml_state->backtrace_last_exn (root) */
- struct caml_memprof_th_ctx memprof_ctx;
+ struct caml_memprof_th_ctx *memprof_ctx;
};
typedef struct caml_thread_struct * caml_thread_t;
static void caml_thread_scan_roots(scanning_action action)
{
- caml_thread_t th;
-
- th = curr_thread;
+ caml_thread_t th = curr_thread;
do {
(*action)(th->descr, &th->descr);
(*action)(th->backtrace_last_exn, &th->backtrace_last_exn);
if (prev_scan_roots_hook != NULL) (*prev_scan_roots_hook)(action);
}
+/* Hook for iterating over Memprof's entries arrays */
+
+static void memprof_ctx_iter(th_ctx_action f, void* data)
+{
+ caml_thread_t th = curr_thread;
+ do {
+ f(th->memprof_ctx, data);
+ th = th->next;
+ } while (th != curr_thread);
+}
+
/* Saving and restoring runtime state in curr_thread */
Caml_inline void caml_thread_save_runtime_state(void)
curr_thread->last_retaddr = Caml_state->last_return_address;
curr_thread->gc_regs = Caml_state->gc_regs;
curr_thread->exception_pointer = Caml_state->exception_pointer;
-#ifdef WITH_SPACETIME
- curr_thread->spacetime_trie_node_ptr
- = caml_spacetime_trie_node_ptr;
- curr_thread->spacetime_finaliser_trie_root
- = caml_spacetime_finaliser_trie_root;
-#endif
#else
curr_thread->stack_low = Caml_state->stack_low;
curr_thread->stack_high = Caml_state->stack_high;
curr_thread->backtrace_pos = Caml_state->backtrace_pos;
curr_thread->backtrace_buffer = Caml_state->backtrace_buffer;
curr_thread->backtrace_last_exn = Caml_state->backtrace_last_exn;
- caml_memprof_save_th_ctx(&curr_thread->memprof_ctx);
+ caml_memprof_leave_thread();
}
Caml_inline void caml_thread_restore_runtime_state(void)
Caml_state->last_return_address = curr_thread->last_retaddr;
Caml_state->gc_regs = curr_thread->gc_regs;
Caml_state->exception_pointer = curr_thread->exception_pointer;
-#ifdef WITH_SPACETIME
- caml_spacetime_trie_node_ptr
- = curr_thread->spacetime_trie_node_ptr;
- caml_spacetime_finaliser_trie_root
- = curr_thread->spacetime_finaliser_trie_root;
-#endif
#else
Caml_state->stack_low = curr_thread->stack_low;
Caml_state->stack_high = curr_thread->stack_high;
Caml_state->backtrace_pos = curr_thread->backtrace_pos;
Caml_state->backtrace_buffer = curr_thread->backtrace_buffer;
Caml_state->backtrace_last_exn = curr_thread->backtrace_last_exn;
- caml_memprof_restore_th_ctx(&curr_thread->memprof_ctx);
+ caml_memprof_enter_thread(curr_thread->memprof_ctx);
}
/* Hooks for caml_enter_blocking_section and caml_leave_blocking_section */
caml_thread_restore_runtime_state();
}
-static int caml_thread_try_leave_blocking_section(void)
-{
- /* Disable immediate processing of signals (PR#3659).
- try_leave_blocking_section always fails, forcing the signal to be
- recorded and processed at the next leave_blocking_section or
- polling. */
- return 0;
-}
-
/* Hooks for I/O locking */
static void caml_io_mutex_free(struct channel *chan)
chan->mutex = mutex;
}
/* PR#4351: first try to acquire mutex without releasing the master lock */
- if (st_mutex_trylock(mutex) == PREVIOUSLY_UNLOCKED) {
+ if (st_mutex_trylock(mutex) == MUTEX_PREVIOUSLY_UNLOCKED) {
st_tls_set(last_channel_locked_key, (void *) chan);
return;
}
th->exception_pointer = NULL;
th->local_roots = NULL;
th->exit_buf = NULL;
-#ifdef WITH_SPACETIME
- /* CR-someday mshinwell: The commented-out changes here are for multicore,
- where we think we should have one trie per domain. */
- th->internal_spacetime_trie_root = Val_unit;
- th->spacetime_trie_node_ptr =
- &caml_spacetime_trie_root; /* &th->internal_spacetime_trie_root; */
- th->internal_spacetime_finaliser_trie_root = Val_unit;
- th->spacetime_finaliser_trie_root
- = caml_spacetime_finaliser_trie_root;
- /* &th->internal_spacetime_finaliser_trie_root; */
- caml_spacetime_register_thread(
- th->spacetime_trie_node_ptr,
- th->spacetime_finaliser_trie_root);
-#endif
#else
/* Allocate the stacks */
th->stack_low = (value *) caml_stat_alloc(Thread_stack_size);
th->backtrace_pos = 0;
th->backtrace_buffer = NULL;
th->backtrace_last_exn = Val_unit;
- caml_memprof_init_th_ctx(&th->memprof_ctx);
+ th->memprof_ctx = caml_memprof_new_th_ctx();
return th;
}
caml_stat_free(th->stack_low);
#endif
if (th->backtrace_buffer != NULL) caml_stat_free(th->backtrace_buffer);
-#ifndef WITH_SPACETIME
caml_stat_free(th);
- /* CR-soon mshinwell: consider what to do about the Spacetime trace. Could
- perhaps have a hook to save a snapshot on thread termination.
- For the moment we can't even free [th], since it contains the trie
- roots. */
-#endif
}
/* Reinitialize the thread machinery after a fork() (PR#4577) */
static void caml_thread_reinitialize(void)
{
- caml_thread_t thr, next;
struct channel * chan;
/* Remove all other threads (now nonexistent)
from the doubly-linked list of threads */
- thr = curr_thread->next;
- while (thr != curr_thread) {
- next = thr->next;
- caml_stat_free(thr);
- thr = next;
+ while (curr_thread->next != curr_thread) {
+ caml_memprof_delete_th_ctx(curr_thread->next->memprof_ctx);
+ caml_thread_remove_info(curr_thread->next);
}
- curr_thread->next = curr_thread;
- curr_thread->prev = curr_thread;
- all_threads = curr_thread;
+
/* Reinitialize the master lock machinery,
just in case the fork happened while other threads were doing
caml_leave_blocking_section */
#ifdef NATIVE_CODE
curr_thread->exit_buf = &caml_termination_jmpbuf;
#endif
+ curr_thread->memprof_ctx = &caml_memprof_main_ctx;
/* The stack-related fields will be filled in at the next
caml_enter_blocking_section */
/* Associate the thread descriptor with the thread */
st_tls_set(thread_descriptor_key, (void *) curr_thread);
+ st_thread_set_id(Ident(curr_thread->descr));
/* Set up the hooks */
prev_scan_roots_hook = caml_scan_roots_hook;
caml_scan_roots_hook = caml_thread_scan_roots;
caml_enter_blocking_section_hook = caml_thread_enter_blocking_section;
caml_leave_blocking_section_hook = caml_thread_leave_blocking_section;
- caml_try_leave_blocking_section_hook = caml_thread_try_leave_blocking_section;
#ifdef NATIVE_CODE
caml_termination_hook = st_thread_exit;
#endif
caml_channel_mutex_unlock_exn = caml_io_mutex_unlock_exn;
prev_stack_usage_hook = caml_stack_usage_hook;
caml_stack_usage_hook = caml_thread_stack_usage;
+ caml_memprof_th_ctx_iter_hook = memprof_ctx_iter;
/* Set up fork() to reinitialize the thread machinery in the child
(PR#4577) */
st_atfork(caml_thread_reinitialize);
below uses accurate information. */
caml_thread_save_runtime_state();
/* Tell memprof that this thread is terminating. */
- caml_memprof_stop_th_ctx(&curr_thread->memprof_ctx);
+ caml_memprof_delete_th_ctx(curr_thread->memprof_ctx);
/* Signal that the thread has terminated */
caml_threadstatus_terminate(Terminated(curr_thread->descr));
/* Remove th from the doubly-linked list of threads and free its info block */
caml_thread_remove_info(curr_thread);
+ /* If no other OCaml thread remains, ask the tick thread to stop
+ so that it does not prevent the whole process from exiting (#9971) */
+ if (all_threads == NULL) caml_thread_cleanup(Val_unit);
/* OS-specific cleanups */
st_thread_cleanup();
/* Release the runtime system */
/* Associate the thread descriptor with the thread */
st_tls_set(thread_descriptor_key, (void *) th);
+ st_thread_set_id(Ident(th->descr));
/* Acquire the global mutex */
caml_leave_blocking_section();
caml_setup_stack_overflow_detection();
/* Now we can re-enter the run-time system and heap-allocate the descriptor */
caml_leave_blocking_section();
th->descr = caml_thread_new_descriptor(Val_unit); /* no closure */
+ st_thread_set_id(Ident(th->descr));
/* Create the tick thread if not already done. */
if (! caml_tick_thread_running) {
err = st_thread_create(&caml_tick_thread_id, caml_thread_tick, NULL);
st_tls_set(thread_descriptor_key, NULL);
/* Remove thread info block from list of threads, and free it */
caml_thread_remove_info(th);
+ /* If no other OCaml thread remains, ask the tick thread to stop
+ so that it does not prevent the whole process from exiting (#9971) */
+ if (all_threads == NULL) caml_thread_cleanup(Val_unit);
/* Release the runtime */
st_masterlock_release(&caml_master_lock);
return 1;
st_retcode retcode;
/* PR#4351: first try to acquire mutex without releasing the master lock */
- if (st_mutex_trylock(mut) == PREVIOUSLY_UNLOCKED) return Val_unit;
+ if (st_mutex_trylock(mut) == MUTEX_PREVIOUSLY_UNLOCKED) return Val_unit;
/* If unsuccessful, block on mutex */
Begin_root(wrapper) /* prevent the deallocation of mutex */
caml_enter_blocking_section();
st_mutex mut = Mutex_val(wrapper);
st_retcode retcode;
retcode = st_mutex_trylock(mut);
- if (retcode == ALREADY_LOCKED) return Val_false;
+ if (retcode == MUTEX_ALREADY_LOCKED) return Val_false;
st_check_error(retcode, "Mutex.try_lock");
return Val_true;
}
#define SIGPREEMPTION SIGTERM
+/* Unique thread identifiers and atomic operations over them */
+#ifdef ARCH_SIXTYFOUR
+typedef LONG64 st_tid;
+#define Tid_Atomic_Exchange InterlockedExchange64
+#define Tid_Atomic_Compare_Exchange InterlockedCompareExchange64
+#else
+typedef LONG st_tid;
+#define Tid_Atomic_Exchange InterlockedExchange
+#define Tid_Atomic_Compare_Exchange InterlockedCompareExchange
+#endif
+
/* Thread-local storage associating a Win32 event to every thread. */
static DWORD st_thread_sem_key;
+/* Thread-local storage for the OCaml thread ID. */
+static DWORD st_thread_id_key;
+
/* OS-specific initialization */
static DWORD st_initialize(void)
{
+ DWORD result = 0;
st_thread_sem_key = TlsAlloc();
if (st_thread_sem_key == TLS_OUT_OF_INDEXES)
return GetLastError();
- else
- return 0;
+ st_thread_id_key = TlsAlloc();
+ if (st_thread_id_key == TLS_OUT_OF_INDEXES) {
+ result = GetLastError();
+ TlsFree(st_thread_sem_key);
+ }
+ return result;
}
/* Thread creation. Created in detached mode if [res] is NULL. */
TlsSetValue(k, v);
}
+/* OS-specific handling of the OCaml thread ID (must be called with the runtime
+ lock). */
+Caml_inline void st_thread_set_id(intnat id)
+{
+ CAMLassert(id != 0);
+ st_tls_set(st_thread_id_key, (void *)id);
+}
+
+/* Return the identifier for the current thread. The 0 value is reserved. */
+Caml_inline intnat st_current_thread_id(void)
+{
+ intnat id = (intnat)st_tls_get(st_thread_id_key);
+ CAMLassert(id != 0);
+ return id;
+}
+
/* The master lock. */
typedef CRITICAL_SECTION st_masterlock;
/* Mutexes */
-typedef CRITICAL_SECTION * st_mutex;
+struct st_mutex_ {
+ CRITICAL_SECTION crit;
+ volatile st_tid owner; /* 0 if unlocked */
+ /* The "owner" field is not always protected by "crit"; it is also
+ accessed without holding "crit", using the Interlocked API for
+ atomic accesses */
+};
+
+typedef struct st_mutex_ * st_mutex;
static DWORD st_mutex_create(st_mutex * res)
{
- st_mutex m = caml_stat_alloc_noexc(sizeof(CRITICAL_SECTION));
+ st_mutex m = caml_stat_alloc_noexc(sizeof(struct st_mutex_));
if (m == NULL) return ERROR_NOT_ENOUGH_MEMORY;
- InitializeCriticalSection(m);
+ InitializeCriticalSection(&m->crit);
+ m->owner = 0;
*res = m;
return 0;
}
static DWORD st_mutex_destroy(st_mutex m)
{
- DeleteCriticalSection(m);
+ DeleteCriticalSection(&m->crit);
caml_stat_free(m);
return 0;
}
+/* Error codes with the 29th bit set are reserved for the application */
+
+#define MUTEX_DEADLOCK (1<<29 | 1)
+#define MUTEX_PREVIOUSLY_UNLOCKED 0
+#define MUTEX_ALREADY_LOCKED (1 << 29)
+#define MUTEX_NOT_OWNED (1<<29 | 2)
+
Caml_inline DWORD st_mutex_lock(st_mutex m)
{
+ st_tid self, prev;
TRACE1("st_mutex_lock", m);
- EnterCriticalSection(m);
+ self = st_current_thread_id();
+ /* Critical sections are recursive locks, so this will succeed
+ if we already own the lock */
+ EnterCriticalSection(&m->crit);
+ /* Record that we are the owner of the lock */
+ prev = Tid_Atomic_Exchange(&m->owner, self);
+ if (prev != 0) {
+ /* The mutex was already locked by ourselves.
+ Cancel the EnterCriticalSection above and return an error. */
+ TRACE1("st_mutex_lock (deadlock)", m);
+ LeaveCriticalSection(&m->crit);
+ return MUTEX_DEADLOCK;
+ }
TRACE1("st_mutex_lock (done)", m);
return 0;
}
-/* Error codes with the 29th bit set are reserved for the application */
-
-#define PREVIOUSLY_UNLOCKED 0
-#define ALREADY_LOCKED (1<<29)
-
Caml_inline DWORD st_mutex_trylock(st_mutex m)
{
+ st_tid self, prev;
TRACE1("st_mutex_trylock", m);
- if (TryEnterCriticalSection(m)) {
- TRACE1("st_mutex_trylock (success)", m);
- return PREVIOUSLY_UNLOCKED;
- } else {
+ self = st_current_thread_id();
+ if (! TryEnterCriticalSection(&m->crit)) {
TRACE1("st_mutex_trylock (failure)", m);
- return ALREADY_LOCKED;
+ return MUTEX_ALREADY_LOCKED;
}
+ /* Record that we are the owner of the lock */
+ prev = Tid_Atomic_Exchange(&m->owner, self);
+ if (prev != 0) {
+ /* The mutex was already locked by ourselves.
+ Cancel the EnterCriticalSection above and return "already locked". */
+ TRACE1("st_mutex_trylock (already locked by self)", m);
+ LeaveCriticalSection(&m->crit);
+ return MUTEX_ALREADY_LOCKED;
+ }
+ TRACE1("st_mutex_trylock (done)", m);
+ return MUTEX_PREVIOUSLY_UNLOCKED;
}
Caml_inline DWORD st_mutex_unlock(st_mutex m)
{
+ st_tid self, prev;
+ /* If the calling thread holds the lock, m->owner is stable and equal
+ to st_current_thread_id().
+ Otherwise, the value of m->owner can be 0 (if the mutex is unlocked)
+ or some other thread ID (if the mutex is held by another thread),
+ but is never equal to st_current_thread_id(). */
+ self = st_current_thread_id();
+ prev = Tid_Atomic_Compare_Exchange(&m->owner, 0, self);
+ if (prev != self) {
+ /* The value of m->owner is unchanged */
+ TRACE1("st_mutex_unlock (error)", m);
+ return MUTEX_NOT_OWNED;
+ }
TRACE1("st_mutex_unlock", m);
- LeaveCriticalSection(m);
+ LeaveCriticalSection(&m->crit);
return 0;
}
{
HANDLE ev;
struct st_wait_list wait;
+ DWORD rc;
+ st_tid self, prev;
TRACE1("st_condvar_wait", c);
/* Recover (or create) the event associated with the calling thread */
if (ev == NULL) return GetLastError();
TlsSetValue(st_thread_sem_key, (void *) ev);
}
- EnterCriticalSection(&c->lock);
+ /* Get ready to release the mutex */
+ self = st_current_thread_id();
+ prev = Tid_Atomic_Compare_Exchange(&m->owner, 0, self);
+ if (prev != self) {
+ /* The value of m->owner is unchanged */
+ TRACE1("st_condvar_wait: error: mutex not held", m);
+ return MUTEX_NOT_OWNED;
+ }
/* Insert the current thread in the waiting list (atomically) */
+ EnterCriticalSection(&c->lock);
wait.event = ev;
wait.next = c->waiters;
c->waiters = &wait;
LeaveCriticalSection(&c->lock);
- /* Release the mutex m */
- LeaveCriticalSection(m);
+ /* Finish releasing the mutex m (like st_mutex_unlock does, minus
+ the error checking, which we've already done above). */
+ LeaveCriticalSection(&m->crit);
/* Wait for our event to be signaled. There is no risk of lost
wakeup, since we inserted ourselves on the waiting list of c
before releasing m */
if (WaitForSingleObject(ev, INFINITE) == WAIT_FAILED)
return GetLastError();
/* Reacquire the mutex m */
- TRACE1("st_condvar_wait: restarted, acquiring mutex", m);
- EnterCriticalSection(m);
- TRACE1("st_condvar_wait: acquired mutex", m);
+ TRACE1("st_condvar_wait: restarted, acquiring mutex", c);
+ rc = st_mutex_lock(m);
+ if (rc != 0) return rc;
+ TRACE1("st_condvar_wait: acquired mutex", c);
return 0;
}
if (retcode == 0) return;
if (retcode == ERROR_NOT_ENOUGH_MEMORY) caml_raise_out_of_memory();
- ret = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS,
- NULL,
- retcode,
- 0,
- err,
- sizeof(err)/sizeof(wchar_t),
- NULL);
- if (! ret) {
- ret =
- swprintf(err, sizeof(err)/sizeof(wchar_t), L"error code %lx", retcode);
+ switch (retcode) {
+ case MUTEX_DEADLOCK:
+ ret = swprintf(err, sizeof(err)/sizeof(wchar_t),
+ L"Mutex is already locked by calling thread");
+ break;
+ case MUTEX_NOT_OWNED:
+ ret = swprintf(err, sizeof(err)/sizeof(wchar_t),
+ L"Mutex is not locked by calling thread");
+ break;
+ default:
+ ret = FormatMessage(
+ FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS,
+ NULL,
+ retcode,
+ 0,
+ err,
+ sizeof(err)/sizeof(wchar_t),
+ NULL);
+ if (! ret) {
+ ret =
+ swprintf(err, sizeof(err)/sizeof(wchar_t), L"error code %lx", retcode);
+ }
}
msglen = strlen(msg);
errlen = win_wide_char_to_multi_byte(err, ret, NULL, 0);
external self : unit -> t = "caml_thread_self" [@@noalloc]
external id : t -> int = "caml_thread_id" [@@noalloc]
external join : t -> unit = "caml_thread_join"
-external exit : unit -> unit = "caml_thread_exit"
+external exit_stub : unit -> unit = "caml_thread_exit"
(* For new, make sure the function passed to thread_new never
raises an exception. *)
+let[@inline never] check_memprof_cb () = ref ()
+
let create fn arg =
thread_new
(fun () ->
try
- fn arg; ()
+ fn arg;
+ ignore (Sys.opaque_identity (check_memprof_cb ()))
with exn ->
flush stdout; flush stderr;
thread_uncaught_exception exn)
+let exit () =
+ ignore (Sys.opaque_identity (check_memprof_cb ()));
+ exit_stub ()
+
(* Thread.kill is currently not implemented due to problems with
cleanup handlers on several platforms *)
directly accessible to the parent thread. *)
val self : unit -> t
-(** Return the thread currently executing. *)
+(** Return the handle for the thread currently executing. *)
val id : t -> int
(** Return the identifier of the given thread. A thread identifier
(** Terminate prematurely the currently executing thread. *)
val kill : t -> unit
-(** Terminate prematurely the thread whose handle is given. *)
+ [@@ocaml.deprecated "Not implemented, do not use"]
+(** This function was supposed to terminate prematurely the thread
+ whose handle is given. It is not currently implemented due to
+ problems with cleanup handlers on many POSIX 1003.1c implementations.
+ It always raises the [Invalid_argument] exception. *)
(** {1 Suspending threads} *)
(** [join th] suspends the execution of the calling thread
until the thread [th] has terminated. *)
+val yield : unit -> unit
+(** Re-schedule the calling thread without suspending it.
+ This function can be used to give scheduling hints,
+ telling the scheduler that now is a good time to
+ switch to other threads. *)
+
+(** {1 Waiting for file descriptors or processes} *)
+
+(** The functions below are leftovers from an earlier, VM-based threading
+ system. The {!Unix} module provides equivalent functionality, in
+ a more general and more standard-conformant manner. It is recommended
+ to use {!Unix} functions directly. *)
+
val wait_read : Unix.file_descr -> unit
-(** See {!Thread.wait_write}.*)
+ [@@ocaml.deprecated "This function no longer does anything"]
+(** This function does nothing in the current implementation of the threading
+ library and can be removed from all user programs. *)
val wait_write : Unix.file_descr -> unit
-(** This function does nothing in this implementation. *)
+ [@@ocaml.deprecated "This function no longer does anything"]
+(** This function does nothing in the current implementation of the threading
+ library and can be removed from all user programs. *)
val wait_timed_read : Unix.file_descr -> float -> bool
(** See {!Thread.wait_timed_write}.*)
val wait_timed_write : Unix.file_descr -> float -> bool
(** Suspend the execution of the calling thread until at least
- one character or EOF is available for reading ([wait_read]) or
- one character can be written without blocking ([wait_write])
+ one character or EOF is available for reading ([wait_timed_read]) or
+ one character can be written without blocking ([wait_timed_write])
on the given Unix file descriptor. Wait for at most
the amount of time given as second argument (in seconds).
Return [true] if the file descriptor is ready for input/output
and [false] if the timeout expired.
-
- These functions return immediately [true] in the Win32
- implementation. *)
+ The same functionality can be achieved with {!Unix.select}.
+*)
val select :
Unix.file_descr list -> Unix.file_descr list ->
Unix.file_descr list -> float ->
Unix.file_descr list * Unix.file_descr list * Unix.file_descr list
-(** Suspend the execution of the calling thread until input/output
+(** Same function as {!Unix.select}.
+ Suspend the execution of the calling thread until input/output
becomes possible on the given Unix file descriptors.
The arguments and results have the same meaning as for
- [Unix.select].
- This function is not implemented yet under Win32. *)
+ {!Unix.select}. *)
val wait_pid : int -> int * Unix.process_status
-(** [wait_pid p] suspends the execution of the calling thread
+(** Same function as {!Unix.waitpid}.
+ [wait_pid p] suspends the execution of the calling thread
until the process specified by the process identifier [p]
terminates. Returns the pid of the child caught and
- its termination status, as per [Unix.wait].
- This function is not implemented under MacOS. *)
-
-val yield : unit -> unit
-(** Re-schedule the calling thread without suspending it.
- This function can be used to give scheduling hints,
- telling the scheduler that now is a good time to
- switch to other threads. *)
+ its termination status, as per {!Unix.wait}. *)
(** {1 Management of signals} *)
(block the calling thread, if required, but do not block all threads
in the process). *)
+[@@@ocaml.deprecated "Use the Unix module instead of ThreadUnix"]
+
(** {1 Process handling} *)
val execv : string -> string array -> unit
-accept.o: accept.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h \
- socketaddr.h ../../runtime/caml/misc.h
-access.o: access.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/domain.h \
- ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h unixsupport.h
-addrofstr.o: addrofstr.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h ../../runtime/caml/fail.h unixsupport.h \
- socketaddr.h ../../runtime/caml/misc.h
-alarm.o: alarm.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl unixsupport.h
-bind.o: bind.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
- ../../runtime/caml/mlvalues.h unixsupport.h socketaddr.h \
- ../../runtime/caml/misc.h
-channels.o: channels.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/io.h \
- ../../runtime/caml/signals.h unixsupport.h socketaddr.h \
- ../../runtime/caml/misc.h
-chdir.o: chdir.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
- ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
- ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h unixsupport.h
-chmod.o: chmod.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
- ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
- ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h unixsupport.h
-chown.o: chown.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
-chroot.o: chroot.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
-close.o: close.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/signals.h \
- unixsupport.h
-closedir.o: closedir.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
-connect.o: connect.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/signals.h unixsupport.h \
- socketaddr.h ../../runtime/caml/misc.h
-cst2constr.o: cst2constr.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/fail.h \
- cst2constr.h
-cstringv.o: cstringv.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
- ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
-dup.o: dup.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
- ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl unixsupport.h
-dup2.o: dup2.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
- ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl unixsupport.h
-envir.o: envir.c ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h
-errmsg.o: errmsg.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h
-execv.o: execv.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
- ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
-execve.o: execve.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
- ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
-execvp.o: execvp.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h unixsupport.h
-exit.o: exit.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
- ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl unixsupport.h
-fchmod.o: fchmod.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/signals.h unixsupport.h
-fchown.o: fchown.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/signals.h unixsupport.h
-fcntl.o: fcntl.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
- ../../runtime/caml/mlvalues.h unixsupport.h
-fork.o: fork.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
- ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/debugger.h \
- ../../runtime/caml/eventlog.h unixsupport.h
-fsync.o: fsync.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/signals.h \
- unixsupport.h
-ftruncate.o: ftruncate.c ../../runtime/caml/fail.h \
- ../../runtime/caml/misc.h ../../runtime/caml/config.h \
- ../../runtime/caml/m.h ../../runtime/caml/s.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/domain_state.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/io.h ../../runtime/caml/signals.h unixsupport.h
-getaddrinfo.o: getaddrinfo.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h ../../runtime/caml/misc.h \
- ../../runtime/caml/signals.h unixsupport.h cst2constr.h socketaddr.h
-getcwd.o: getcwd.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
- ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
- ../../runtime/caml/domain.h unixsupport.h
-getegid.o: getegid.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl unixsupport.h
-geteuid.o: geteuid.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl unixsupport.h
-getgid.o: getgid.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl unixsupport.h
-getgr.o: getgr.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/fail.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h unixsupport.h
-getgroups.o: getgroups.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h unixsupport.h
-gethost.o: gethost.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h \
- socketaddr.h ../../runtime/caml/misc.h
-gethostname.o: gethostname.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h unixsupport.h
-getlogin.o: getlogin.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- unixsupport.h
-getnameinfo.o: getnameinfo.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h \
- socketaddr.h ../../runtime/caml/misc.h
-getpeername.o: getpeername.c ../../runtime/caml/fail.h \
- ../../runtime/caml/misc.h ../../runtime/caml/config.h \
- ../../runtime/caml/m.h ../../runtime/caml/s.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/domain_state.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/mlvalues.h \
- unixsupport.h socketaddr.h ../../runtime/caml/misc.h
-getpid.o: getpid.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl unixsupport.h
-getppid.o: getppid.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl unixsupport.h
-getproto.o: getproto.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h unixsupport.h
-getpw.o: getpw.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/domain.h \
- ../../runtime/caml/fail.h unixsupport.h
-getserv.o: getserv.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h unixsupport.h
-getsockname.o: getsockname.c ../../runtime/caml/fail.h \
- ../../runtime/caml/misc.h ../../runtime/caml/config.h \
- ../../runtime/caml/m.h ../../runtime/caml/s.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/domain_state.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/mlvalues.h \
- unixsupport.h socketaddr.h ../../runtime/caml/misc.h
-gettimeofday.o: gettimeofday.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h unixsupport.h
-getuid.o: getuid.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl unixsupport.h
-gmtime.o: gmtime.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h unixsupport.h
-initgroups.o: initgroups.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h unixsupport.h
-isatty.o: isatty.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl unixsupport.h
-itimer.o: itimer.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h unixsupport.h
-kill.o: kill.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
- ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/fail.h \
- unixsupport.h ../../runtime/caml/signals.h
-link.o: link.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
- ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
-listen.o: listen.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
- ../../runtime/caml/mlvalues.h unixsupport.h
-lockf.o: lockf.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/signals.h unixsupport.h
-lseek.o: lseek.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/io.h ../../runtime/caml/signals.h unixsupport.h
-mkdir.o: mkdir.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
-mkfifo.o: mkfifo.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
-mmap.o: mmap.c ../../runtime/caml/bigarray.h ../../runtime/caml/config.h \
- ../../runtime/caml/m.h ../../runtime/caml/s.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
- ../../runtime/caml/fail.h ../../runtime/caml/io.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/signals.h \
- ../../runtime/caml/sys.h unixsupport.h
-mmap_ba.o: mmap_ba.c ../../runtime/caml/alloc.h ../../runtime/caml/misc.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
- ../../runtime/caml/bigarray.h ../../runtime/caml/custom.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
- ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
- ../../runtime/caml/domain.h ../../runtime/caml/misc.h
-nice.o: nice.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
- ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl unixsupport.h
-open.o: open.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
- ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/domain.h \
- ../../runtime/caml/misc.h ../../runtime/caml/signals.h unixsupport.h
-opendir.o: opendir.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h ../../runtime/caml/alloc.h \
- ../../runtime/caml/signals.h unixsupport.h
-pipe.o: pipe.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
- ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- unixsupport.h
-putenv.o: putenv.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
- ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
- ../../runtime/caml/domain.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
-read.o: read.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
- ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
-readdir.o: readdir.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/fail.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/signals.h unixsupport.h
-readlink.o: readlink.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h ../../runtime/caml/signals.h unixsupport.h
-rename.o: rename.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
-rewinddir.o: rewinddir.c ../../runtime/caml/fail.h \
- ../../runtime/caml/misc.h ../../runtime/caml/config.h \
- ../../runtime/caml/m.h ../../runtime/caml/s.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/domain_state.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/mlvalues.h \
- unixsupport.h
-rmdir.o: rmdir.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
- ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
- ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h unixsupport.h
-select.o: select.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
-sendrecv.o: sendrecv.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h \
- socketaddr.h ../../runtime/caml/misc.h
-setgid.o: setgid.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl unixsupport.h
-setgroups.o: setgroups.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h unixsupport.h
-setsid.o: setsid.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
- ../../runtime/caml/mlvalues.h unixsupport.h
-setuid.o: setuid.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl unixsupport.h
-shutdown.o: shutdown.c ../../runtime/caml/fail.h \
- ../../runtime/caml/misc.h ../../runtime/caml/config.h \
- ../../runtime/caml/m.h ../../runtime/caml/s.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/domain_state.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/mlvalues.h \
- unixsupport.h
-signals.o: signals.c ../../runtime/caml/alloc.h ../../runtime/caml/misc.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
- ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
- ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/signals.h unixsupport.h
-sleep.o: sleep.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/signals.h \
- unixsupport.h
-socket.o: socket.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
- ../../runtime/caml/mlvalues.h unixsupport.h
-socketaddr.o: socketaddr.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/domain.h unixsupport.h \
- socketaddr.h ../../runtime/caml/misc.h
-socketpair.o: socketpair.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h unixsupport.h
-sockopt.o: sockopt.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h unixsupport.h socketaddr.h \
- ../../runtime/caml/misc.h
-stat.o: stat.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
- ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
- ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/signals.h \
- ../../runtime/caml/io.h unixsupport.h cst2constr.h nanosecond_stat.h
-strofaddr.o: strofaddr.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h unixsupport.h socketaddr.h \
- ../../runtime/caml/misc.h
-symlink.o: symlink.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
-termios.o: termios.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h unixsupport.h
-time.o: time.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
- ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- unixsupport.h
-times.o: times.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/domain.h unixsupport.h
-truncate.o: truncate.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
- ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
- ../../runtime/caml/fail.h ../../runtime/caml/signals.h \
- ../../runtime/caml/io.h unixsupport.h
-umask.o: umask.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl unixsupport.h
-unixsupport.o: unixsupport.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/callback.h ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h ../../runtime/caml/fail.h unixsupport.h \
- cst2constr.h
-unlink.o: unlink.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
- ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
- ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h unixsupport.h
-utimes.o: utimes.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
- ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
- ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h unixsupport.h
-wait.o: wait.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
- ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
- ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
- ../../runtime/caml/signals.h unixsupport.h
-write.o: write.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
unix.cmo : \
unix.cmi
unix.cmx : \
EXTRACAMLFLAGS=-nolabels
+unixLabels.cmi: \
+ EXTRACAMLFLAGS += -pp "$(AWK) -f $(ROOTDIR)/stdlib/expand_module_aliases.awk"
+
# dllunix.so particularly requires libm for modf symbols
LDOPTS=$(NATIVECCLIBS)
readdir.o readlink.o rename.o rewinddir.o rmdir.o select.o sendrecv.o \
setgid.o setgroups.o setsid.o setuid.o shutdown.o signals.o \
sleep.o socket.o socketaddr.o \
- socketpair.o sockopt.o stat.o strofaddr.o symlink.o termios.o \
+ socketpair.o sockopt.o spawn.o stat.o strofaddr.o symlink.o termios.o \
time.o times.o truncate.o umask.o unixsupport.o unlink.o \
utimes.o wait.o write.o
.PHONY: depend
depend:
-ifeq "$(TOOLCHAIN)" "msvc"
- $(error Dependencies cannot be regenerated using the MSVC ports)
-else
- $(CC) -MM $(OC_CPPFLAGS) *.c > .depend
- $(CAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash *.mli *.ml >> .depend
-endif
+ $(CAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash *.mli *.ml > .depend
include .depend
}
}
-/* From runtime/io.c. To be declared in <caml/io.h> ? */
-extern value caml_ml_open_descriptor_in(value fd);
-extern value caml_ml_open_descriptor_out(value fd);
-
CAMLprim value unix_inchannel_of_filedescr(value fd)
{
int err;
/**************************************************************************/
#define _GNU_SOURCE /* helps to find execvpe() */
+#include <string.h>
#include <caml/mlvalues.h>
#include <caml/memory.h>
#define CAML_INTERNALS
/* from smart compilers */
}
-#ifdef HAS_EXECVPE
+#ifndef HAS_EXECVPE
+int unix_execvpe_emulation(const char * name,
+ char * const argv[],
+ char * const envp[]);
+#endif
CAMLprim value unix_execvpe(value path, value args, value env)
{
char_os ** argv;
char_os ** envp;
char_os * wpath;
+ int err;
caml_unix_check_path(path, "execvpe");
argv = cstringvect(args, "execvpe");
envp = cstringvect(env, "execvpe");
wpath = caml_stat_strdup_to_os(String_val(path));
+#ifdef HAS_EXECVPE
(void) execvpe_os((const char_os *)wpath, EXECV_CAST argv, EXECV_CAST envp);
+ err = errno;
+#else
+ err = unix_execvpe_emulation(wpath, argv, envp);
+#endif
caml_stat_free(wpath);
cstringvect_free(argv);
cstringvect_free(envp);
- uerror("execvpe", path);
+ unix_error(err, "execvpe", path);
return Val_unit; /* never reached, but suppress warnings */
/* from smart compilers */
}
-#else
+#ifndef HAS_EXECVPE
-CAMLprim value unix_execvpe(value path, value args, value env)
+static int unix_execve_script(const char * path,
+ char * const argv[],
+ char * const envp[])
+{
+ size_t argc, i;
+ char ** new_argv;
+
+ /* Try executing directly. Will not return if it succeeds. */
+ execve(path, argv, envp);
+ if (errno != ENOEXEC) return errno;
+ /* Try executing as a shell script. */
+ for (argc = 0; argv[argc] != NULL; argc++) /*skip*/;
+ /* The new argument vector is
+ {"/bin/sh", path, argv[1], ..., argv[argc-1], NULL} */
+ new_argv = calloc(argc + 3, sizeof (char *));
+ if (new_argv == NULL) return ENOMEM;
+ new_argv[0] = "/bin/sh";
+ new_argv[1] = (char *) path;
+ for (i = 1; i < argc; i++) new_argv[i + 1] = argv[i];
+ new_argv[argc + 1] = NULL;
+ /* Execute the shell with the new argument vector.
+ Will not return if it succeeds. */
+ execve(new_argv[0], new_argv, envp);
+ /* Shell execution failed. */
+ free(new_argv);
+ return errno;
+}
+
+int unix_execvpe_emulation(const char * name,
+ char * const argv[],
+ char * const envp[])
{
- unix_error(ENOSYS, "execvpe", path);
- return Val_unit;
+ char * searchpath, * p, * q, * fullname;
+ size_t namelen, dirlen;
+ int r, got_eacces;
+
+ /* If name contains a '/', do not search in path */
+ if (strchr(name, '/') != NULL) return unix_execve_script(name, argv, envp);
+ /* Determine search path */
+ searchpath = getenv("PATH");
+ if (searchpath == NULL) searchpath = "/bin:/usr/bin";
+ if (searchpath[0] == 0) return ENOENT;
+ namelen = strlen(name);
+ got_eacces = 0;
+ p = searchpath;
+ while (1) {
+ /* End of path component is next ':' or end of string */
+ for (q = p; *q != 0 && *q != ':'; q++) /*skip*/;
+ /* Path component is between p (included) and q (excluded) */
+ dirlen = q - p;
+ if (dirlen == 0) {
+ /* An empty path component means "current working directory" */
+ r = unix_execve_script(name, argv, envp);
+ } else {
+ /* Construct the string "directory/name" */
+ fullname = malloc(dirlen + 1 + namelen + 1);
+ if (fullname == NULL) return ENOMEM;
+ memcpy(fullname, p, dirlen); /* copy directory from path */
+ fullname[dirlen] = '/'; /* add separator */
+ memcpy(fullname + dirlen + 1, name, namelen + 1);
+ /* add name, including final 0 */
+ r = unix_execve_script(fullname, argv, envp);
+ free(fullname);
+ }
+ switch (r) {
+ case EACCES:
+ /* Record that we got a "Permission denied" error and continue. */
+ got_eacces = 1; break;
+ case ENOENT: case ENOTDIR:
+ /* The file was not found. Continue the search. */
+ break;
+ case EISDIR: case ELOOP:
+ case ENODEV: case ETIMEDOUT:
+ /* Strange, unexpected error. Continue the search. */
+ break;
+ default:
+ /* Serious error. We found an executable file but could not
+ execute it. Stop the search and return the error. */
+ return r;
+ }
+ /* Continue with next path component, if any */
+ if (*q == 0) break;
+ p = q + 1; /* skip ':' */
+ }
+ /* If we found a file but had insufficient permissions, return
+ EACCES to our caller. Otherwise, say we did not find a file
+ (ENOENT). */
+ return got_eacces ? EACCES : ENOENT;
}
#endif
#include <caml/alloc.h>
#include <caml/fail.h>
#include "unixsupport.h"
-
-#ifdef HAS_GETTIMEOFDAY
-
#include <sys/types.h>
#include <sys/time.h>
-CAMLprim value unix_gettimeofday(value unit)
+double unix_gettimeofday_unboxed(value unit)
{
struct timeval tp;
- if (gettimeofday(&tp, NULL) == -1) uerror("gettimeofday", Nothing);
- return caml_copy_double((double) tp.tv_sec + (double) tp.tv_usec / 1e6);
+ gettimeofday(&tp, NULL);
+ return ((double) tp.tv_sec + (double) tp.tv_usec / 1e6);
}
-#else
-
CAMLprim value unix_gettimeofday(value unit)
-{ caml_invalid_argument("gettimeofday not implemented"); }
-
-#endif
+{
+ return caml_copy_double(unix_gettimeofday_unboxed(unit));
+}
sig = caml_convert_signal_number(Int_val(signal));
if (kill(Int_val(pid), sig) == -1)
uerror("kill", Nothing);
+ caml_process_pending_actions();
return Val_unit;
}
/* */
/**************************************************************************/
+#ifndef _WIN32
#include <sys/types.h>
#include <sys/stat.h>
+#endif
+
+#define CAML_INTERNALS
#include <caml/mlvalues.h>
+#include <caml/osdeps.h>
+#include <caml/misc.h>
#include <caml/memory.h>
#include <caml/signals.h>
#include "unixsupport.h"
CAMLprim value unix_mkdir(value path, value perm)
{
CAMLparam2(path, perm);
- char * p;
+ char_os * p;
int ret;
caml_unix_check_path(path, "mkdir");
- p = caml_stat_strdup(String_val(path));
+ p = caml_stat_strdup_to_os(String_val(path));
caml_enter_blocking_section();
- ret = mkdir(p, Int_val(perm));
+ ret = mkdir_os(p, Int_val(perm));
caml_leave_blocking_section();
caml_stat_free(p);
if (ret == -1) uerror("mkdir", path);
#endif
/* Defined in [mmap_ba.c] */
-CAMLextern value
-caml_unix_mapped_alloc(int flags, int num_dims, void * data, intnat * dim);
+extern value caml_unix_mapped_alloc(int, int, void *, intnat *);
#if defined(HAS_MMAP)
/* Allocation of bigarrays for memory-mapped files.
This is the OS-independent part of [mmap.c]. */
-CAMLextern void caml_ba_unmap_file(void * addr, uintnat len);
+extern void caml_ba_unmap_file(void *, uintnat);
static void caml_ba_mapped_finalize(value v)
{
CAMLprim value unix_setsid(value unit)
{
#ifdef HAS_SETSID
- return Val_int(setsid());
+ pid_t pid = setsid();
+ if (pid == (pid_t)(-1)) uerror("setsid", Nothing);
+ return Val_long(pid);
#else
caml_invalid_argument("setsid not implemented");
return Val_unit;
caml_enter_blocking_section();
retcode = caml_sigmask_hook(how, &set, &oldset);
caml_leave_blocking_section();
+ /* Run any handlers for just-unmasked pending signals */
+ caml_process_pending_actions();
if (retcode != 0) unix_error(retcode, "sigprocmask", Nothing);
return encode_sigset(&oldset);
}
#define CAML_SOCKETADDR_H
#include "caml/misc.h"
+#ifndef _WIN32
#include <sys/types.h>
#include <sys/socket.h>
#include <sys/un.h>
#include <netinet/in.h>
#include <arpa/inet.h>
+#endif
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;
extern void get_sockaddr (value mladdr,
union sock_addr_union * addr /*out*/,
socklen_param_type * addr_len /*out*/);
-CAMLexport value alloc_sockaddr (union sock_addr_union * addr /*in*/,
+extern value alloc_sockaddr (union sock_addr_union * addr /*in*/,
socklen_param_type addr_len, int close_on_error);
-CAMLexport value alloc_inet_addr (struct in_addr * inaddr);
+extern value alloc_inet_addr (struct in_addr * inaddr);
#define GET_INET_ADDR(v) (*((struct in_addr *) (v)))
#ifdef HAS_IPV6
-CAMLexport value alloc_inet6_addr (struct in6_addr * inaddr);
+extern value alloc_inet6_addr (struct in6_addr * inaddr);
#define GET_INET6_ADDR(v) (*((struct in6_addr *) (v)))
#endif
#ifndef SO_REUSEADDR
#define SO_REUSEADDR (-1)
#endif
+#ifndef SO_REUSEPORT
+#define SO_REUSEPORT (-1)
+#endif
#ifndef SO_KEEPALIVE
#define SO_KEEPALIVE (-1)
#endif
{ SOL_SOCKET, SO_OOBINLINE },
{ SOL_SOCKET, SO_ACCEPTCONN },
{ IPPROTO_TCP, TCP_NODELAY },
- { IPPROTO_IPV6, IPV6_V6ONLY}
+ { IPPROTO_IPV6, IPV6_V6ONLY},
+ { SOL_SOCKET, SO_REUSEPORT }
};
static struct socket_option sockopt_int[] = {
--- /dev/null
+/**************************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Xavier Leroy, projet Cambium, Collège de France and 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. */
+/* */
+/**************************************************************************/
+
+#define _GNU_SOURCE /* helps to find execvpe() */
+#include <errno.h>
+#include <sys/types.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include "unixsupport.h"
+
+#ifdef HAS_POSIX_SPAWN
+
+#include <spawn.h>
+
+extern char ** environ;
+
+/* Implementation based on posix_spawn() */
+
+CAMLprim value unix_spawn(value executable, /* string */
+ value args, /* string array */
+ value optenv, /* string array option */
+ value usepath, /* bool */
+ value redirect) /* int array (size 3) */
+{
+ char ** argv;
+ char ** envp;
+ const char * path;
+ pid_t pid;
+ int src, dst, r, i;
+ posix_spawn_file_actions_t act;
+
+ caml_unix_check_path(executable, "create_process");
+ path = String_val(executable);
+ argv = cstringvect(args, "create_process");
+ if (Is_block(optenv)) {
+ envp = cstringvect(Field(optenv, 0), "create_process");
+ } else {
+ envp = environ;
+ }
+ /* Prepare the redirections for stdin, stdout, stderr */
+ posix_spawn_file_actions_init(&act);
+ for (dst = 0; dst <= 2; dst++) {
+ /* File descriptor [redirect.(dst)] becomes file descriptor [dst] */
+ src = Int_val(Field(redirect, dst));
+ if (src != dst) {
+ r = posix_spawn_file_actions_adddup2(&act, src, dst);
+ if (r != 0) goto error;
+ /* Close [src] if this is its last use */
+ for (i = dst + 1; i <= 2; i++) {
+ if (src == Int_val(Field(redirect, i))) goto dontclose;
+ }
+ r = posix_spawn_file_actions_addclose(&act, src);
+ if (r != 0) goto error;
+ dontclose:
+ /*skip*/;
+ }
+ }
+ /* Spawn the new process */
+ if (Bool_val(usepath)) {
+ r = posix_spawnp(&pid, path, &act, NULL, argv, envp);
+ } else {
+ r = posix_spawn(&pid, path, &act, NULL, argv, envp);
+ }
+ error:
+ posix_spawn_file_actions_destroy(&act);
+ cstringvect_free(argv);
+ if (Is_block(optenv)) cstringvect_free(envp);
+ if (r != 0) unix_error(r, "create_process", executable);
+ return Val_long(pid);
+}
+
+#else
+
+/* Fallback implementation based on fork() and exec() */
+
+#ifndef HAS_EXECVPE
+extern int unix_execvpe_emulation(const char * name,
+ char * const argv[],
+ char * const envp[]);
+#endif
+
+/* Exit code used for the child process to report failure to exec */
+/* This is consistent with system() and allowed by posix_spawn() specs */
+
+#define ERROR_EXIT_STATUS 127
+
+CAMLprim value unix_spawn(value executable, /* string */
+ value args, /* string array */
+ value optenv, /* string array option */
+ value usepath, /* bool */
+ value redirect) /* int array (size 3) */
+{
+ char ** argv;
+ char ** envp;
+ const char * path;
+ pid_t pid;
+ int src, dst, i;
+
+ caml_unix_check_path(executable, "create_process");
+ path = String_val(executable);
+ argv = cstringvect(args, "create_process");
+ if (Is_block(optenv)) {
+ envp = cstringvect(Field(optenv, 0), "create_process");
+ } else {
+ envp = NULL;
+ }
+ pid = fork();
+ if (pid != 0) {
+ /* This is the parent process */
+ cstringvect_free(argv);
+ if (envp != NULL) cstringvect_free(envp);
+ if (pid == -1) uerror("create_process", executable);
+ return Val_long(pid);
+ }
+ /* This is the child process */
+ /* Perform the redirections for stdin, stdout, stderr */
+ for (dst = 0; dst <= 2; dst++) {
+ /* File descriptor [redirect.(dst)] becomes file descriptor [dst] */
+ src = Int_val(Field(redirect, dst));
+ if (src != dst) {
+ if (dup2(src, dst) == -1) _exit(ERROR_EXIT_STATUS);
+ /* Close [src] if this is its last use */
+ for (i = dst + 1; i <= 2; i++) {
+ if (src == Int_val(Field(redirect, i))) goto dontclose;
+ }
+ if (close(src) == -1) _exit(ERROR_EXIT_STATUS);
+ dontclose:
+ /*skip*/;
+ }
+ }
+ /* Transfer control to the executable */
+ if (Bool_val(usepath)) {
+ if (envp == NULL) {
+ execvp(path, argv);
+ } else {
+#ifdef HAS_EXECVPE
+ execvpe(path, argv, envp);
+#else
+ unix_execvpe_emulation(path, argv, envp);
+#endif
+ }
+ } else {
+ if (envp == NULL) {
+ execv(path, argv);
+ } else {
+ execve(path, argv, envp);
+ }
+ }
+ /* If we get here, the exec*() call failed. */
+ _exit(ERROR_EXIT_STATUS);
+}
+
+#endif
#include <caml/alloc.h>
#include "unixsupport.h"
+double unix_time_unboxed(value unit)
+{
+ return ((double) time((time_t *) NULL));
+}
+
CAMLprim value unix_time(value unit)
{
- return caml_copy_double((double) time((time_t *) NULL));
+ return caml_copy_double(unix_time_unboxed(unit));
}
external execv : string -> string array -> 'a = "unix_execv"
external execve : string -> string array -> string array -> 'a = "unix_execve"
external execvp : string -> string array -> 'a = "unix_execvp"
-external execvpe_c :
- string -> string array -> string array -> 'a = "unix_execvpe"
-
-let execvpe_ml name args env =
- (* Try to execute the given file *)
- let exec file =
- try
- execve file args env
- with Unix_error(ENOEXEC, _, _) ->
- (* Assume this is a script and try to execute through the shell *)
- let argc = Array.length args in
- (* Drop the original args.(0) if it is there *)
- let new_args = Array.append
- [| shell; file |]
- (if argc = 0 then args else Array.sub args 1 (argc - 1)) in
- execve new_args.(0) new_args env in
- (* Try each path element in turn *)
- let rec scan_dir eacces = function
- | [] ->
- (* No matching file was found (if [eacces = false]) or
- a matching file was found but we got a "permission denied"
- error while trying to execute it (if [eacces = true]).
- Raise the error appropriate to each case. *)
- raise (Unix_error((if eacces then EACCES else ENOENT),
- "execvpe", name))
- | dir :: rem ->
- let dir = (* an empty path element means the current directory *)
- if dir = "" then Filename.current_dir_name else dir in
- try
- exec (Filename.concat dir name)
- with Unix_error(err, _, _) as exn ->
- match err with
- (* The following errors are treated as nonfatal, meaning that
- we will ignore them and continue searching in the path.
- Among those errors, EACCES is recorded specially so as
- to produce the correct exception in the end.
- To determine which errors are nonfatal, we looked at the
- execvpe() sources in Glibc and in OpenBSD. *)
- | EACCES ->
- scan_dir true rem
- | EISDIR|ELOOP|ENAMETOOLONG|ENODEV|ENOENT|ENOTDIR|ETIMEDOUT ->
- scan_dir eacces rem
- (* Other errors, e.g. E2BIG, are fatal and abort the search. *)
- | _ ->
- raise exn in
- if String.contains name '/' then
- (* If the command name contains "/" characters, don't search in path *)
- exec name
- else
- (* Split path into elements and search in these elements *)
- (try unsafe_getenv "PATH" with Not_found -> "/bin:/usr/bin")
- |> String.split_on_char ':'
- |> scan_dir false
- (* [unsafe_getenv] and not [getenv] to be consistent with [execvp],
- which looks up the PATH environment variable whether SUID or not. *)
-
-let execvpe name args env =
- try
- execvpe_c name args env
- with Unix_error(ENOSYS, _, _) ->
- execvpe_ml name args env
+external execvpe : string -> string array -> string array -> 'a = "unix_execvpe"
external fork : unit -> int = "unix_fork"
external wait : unit -> int * process_status = "unix_wait"
external waitpid : wait_flag list -> int -> int * process_status
= "unix_waitpid"
+external _exit : int -> 'a = "unix_exit"
external getpid : unit -> int = "unix_getpid"
external getppid : unit -> int = "unix_getppid"
external nice : int -> int = "unix_nice"
tm_yday : int;
tm_isdst : bool }
-external time : unit -> float = "unix_time"
-external gettimeofday : unit -> float = "unix_gettimeofday"
+external time : unit -> (float [@unboxed]) =
+ "unix_time" "unix_time_unboxed" [@@noalloc]
+external gettimeofday : unit -> (float [@unboxed]) =
+ "unix_gettimeofday" "unix_gettimeofday_unboxed" [@@noalloc]
external gmtime : float -> tm = "unix_gmtime"
external localtime : float -> tm = "unix_localtime"
external mktime : tm -> float * tm = "unix_mktime"
| SO_ACCEPTCONN
| TCP_NODELAY
| IPV6_ONLY
+ | SO_REUSEPORT
type socket_int_option =
SO_SNDBUF
try waitpid [] pid
with Unix_error (EINTR, _, _) -> waitpid_non_intr pid
-external sys_exit : int -> 'a = "caml_sys_exit"
+external spawn : string -> string array -> string array option ->
+ bool -> int array -> int
+ = "unix_spawn"
let system cmd =
- match fork() with
- 0 -> begin try
- execv shell [| shell; "-c"; cmd |]
- with _ ->
- sys_exit 127
- end
- | id -> snd(waitpid_non_intr id)
-
-(* Duplicate [fd] if needed to make sure it isn't one of the
- standard descriptors (stdin, stdout, stderr).
- Note that this function always leaves the standard descriptors open,
- the caller must take care of closing them if needed.
- The "cloexec" mode doesn't matter, because
- the descriptor returned by [dup] will be closed before the [exec],
- and because no other thread is running concurrently
- (we are in the child process of a fork).
- *)
-let rec file_descr_not_standard fd =
- if fd >= 3 then fd else file_descr_not_standard (dup fd)
-
-let safe_close fd =
- try close fd with Unix_error(_,_,_) -> ()
-
-let perform_redirections new_stdin new_stdout new_stderr =
- let new_stdin = file_descr_not_standard new_stdin in
- let new_stdout = file_descr_not_standard new_stdout in
- let new_stderr = file_descr_not_standard new_stderr in
- (* The three dup2 close the original stdin, stdout, stderr,
- which are the descriptors possibly left open
- by file_descr_not_standard *)
- dup2 ~cloexec:false new_stdin stdin;
- dup2 ~cloexec:false new_stdout stdout;
- dup2 ~cloexec:false new_stderr stderr;
- safe_close new_stdin;
- safe_close new_stdout;
- safe_close new_stderr
+ let pid = spawn shell [| shell; "-c"; cmd |] None false [| 0; 1; 2 |] in
+ snd(waitpid_non_intr pid)
+
+let create_process_gen usepath cmd args optenv
+ new_stdin new_stdout new_stderr =
+ let toclose = ref [] in
+ let close_after () =
+ List.iter
+ (fun fd -> try close fd with Unix_error(_,_,_) -> ())
+ !toclose in
+ (* Duplicate [fd] if needed to make sure it isn't one of the
+ standard descriptors (stdin, stdout, stderr).
+ The temporary file descriptors created here will be closed
+ after the spawn, both in the parent (call to [close_after] below)
+ and in the child (they are close-on-exec). *)
+ let rec file_descr_not_standard fd =
+ if fd >= 3 then fd else begin
+ let fd' = dup ~cloexec:true fd in
+ toclose := fd' :: !toclose;
+ file_descr_not_standard fd'
+ end in
+ (* As an optimization, if a standard descriptor is not redirected,
+ i.e. "redirected to itself", don't duplicate it: the [unix_spawn]
+ C stub will perform no redirection either. *)
+ let redirections = [|
+ (if new_stdin = 0 then 0 else file_descr_not_standard new_stdin);
+ (if new_stdout = 1 then 1 else file_descr_not_standard new_stdout);
+ (if new_stderr = 2 then 2 else file_descr_not_standard new_stderr)
+ |] in
+ Fun.protect ~finally:close_after
+ (fun () -> spawn cmd args optenv usepath redirections)
let create_process cmd args new_stdin new_stdout new_stderr =
- match fork() with
- 0 ->
- begin try
- perform_redirections new_stdin new_stdout new_stderr;
- execvp cmd args
- with _ ->
- sys_exit 127
- end
- | id -> id
+ create_process_gen true cmd args None new_stdin new_stdout new_stderr
let create_process_env cmd args env new_stdin new_stdout new_stderr =
- match fork() with
- 0 ->
- begin try
- perform_redirections new_stdin new_stdout new_stderr;
- execvpe cmd args env
- with _ ->
- sys_exit 127
- end
- | id -> id
+ create_process_gen true cmd args (Some env) new_stdin new_stdout new_stderr
type popen_process =
Process of in_channel * out_channel
let popen_processes = (Hashtbl.create 7 : (popen_process, int) Hashtbl.t)
let open_proc prog args envopt proc input output error =
- match fork() with
- 0 -> perform_redirections input output error;
- begin try
- match envopt with
- | Some env -> execve prog args env
- | None -> execv prog args
- with _ ->
- sys_exit 127
- end
- | id -> Hashtbl.add popen_processes proc id
+ let pid =
+ create_process_gen false prog args envopt input output error in
+ Hashtbl.add popen_processes proc pid
let open_process_args_in prog args =
let (in_read, in_write) = pipe ~cloexec:true () in
(* The "double fork" trick, the process which calls server_fun will not
leave a zombie process *)
match fork() with
- 0 -> if fork() <> 0 then sys_exit 0;
- (* The son exits, the grandson works *)
+ 0 -> if fork() <> 0 then _exit 0;
+ (* The child exits, the grandchild works *)
close sock;
let inchan = in_channel_of_descr s in
let outchan = out_channel_of_descr s in
have done it already, and we are about to exit anyway
(PR#3794) *)
exit 0
- | id -> close s; ignore(waitpid_non_intr id) (* Reclaim the son *)
+ | id -> close s; ignore(waitpid_non_intr id) (* Reclaim the child *)
done
(* *)
(**************************************************************************)
+(* NOTE:
+ If this file is unixLabels.mli, run tools/sync_stdlib_docs after editing it
+ to generate unix.mli.
+
+ If this file is unix.mli, do not edit it directly -- edit unixLabels.mli
+ instead.
+*)
+
+(* NOTE:
+ When a new function is added which is not implemented on Windows (or
+ partially implemented), or the Windows-status of an existing function is
+ changed, remember to update the summary table in
+ manual/manual/library/libunix.etex
+*)
+
(** Interface to the Unix system.
- Note: all the functions of this module (except {!error_message} and
- {!handle_unix_error}) are liable to raise the {!Unix_error}
- exception whenever the underlying system call signals an error. *)
+ To use the labeled version of this module, add [module Unix][ = ][UnixLabels]
+ in your implementation.
+ Note: all the functions of this module (except {!error_message} and
+ {!handle_unix_error}) are liable to raise the {!Unix_error}
+ exception whenever the underlying system call signals an error.
+*)
(** {1 Error report} *)
(** Raised by the system calls below when an error is encountered.
The first component is the error code; the second component
is the function name; the third component is the string parameter
- to the function, if it has one, or the empty string otherwise. *)
+ to the function, if it has one, or the empty string otherwise.
+
+ {!UnixLabels.Unix_error} and {!Unix.Unix_error} are the same, and
+ catching one will catch the other. *)
val error_message : error -> string
(** Return a string describing the given error code. *)
privileges. See the documentation for {!unsafe_getenv} for more
details.
- @since 4.06.0 *)
+ @since 4.06.0 (4.12.0 in UnixLabels) *)
val getenv : string -> string
(** Return the value associated to a variable in the process
@raise Not_found if the variable is unbound or the process has
special privileges.
- (This function is identical to {!Sys.getenv}. *)
+ This function is identical to {!Sys.getenv}. *)
val unsafe_getenv : string -> string
(** Return the value associated to a variable in the process
@since 4.06.0 *)
val putenv : string -> string -> unit
-(** [Unix.putenv name value] sets the value associated to a
+(** [putenv name value] sets the value associated to a
variable in the process environment.
[name] is the name of the environment variable,
and [value] its new associated value. *)
type wait_flag =
WNOHANG (** Do not block if no child has
- died yet, but immediately return with a pid equal to 0.*)
+ died yet, but immediately return with a pid equal to 0. *)
| WUNTRACED (** Report also the children that receive stop signals. *)
-(** Flags for {!Unix.waitpid}. *)
+(** Flags for {!waitpid}. *)
val execv : string -> string array -> 'a
(** [execv prog args] execute the program in file [prog], with
the arguments [args], and the current process environment.
These [execv*] functions never return: on success, the current
program is replaced by the new one.
- @raise Unix.Unix_error on failure. *)
+ @raise Unix_error on failure *)
val execve : string -> string array -> string array -> 'a
-(** Same as {!Unix.execv}, except that the third argument provides the
+(** Same as {!execv}, except that the third argument provides the
environment to the program executed. *)
val execvp : string -> string array -> 'a
-(** Same as {!Unix.execv}, except that
+(** Same as {!execv}, except that
the program is searched in the path. *)
val execvpe : string -> string array -> string array -> 'a
-(** Same as {!Unix.execve}, except that
+(** Same as {!execve}, except that
the program is searched in the path. *)
val fork : unit -> int
(** Wait until one of the children processes die, and return its pid
and termination status.
- On Windows: Not implemented, use {!waitpid}. *)
+ On Windows: not implemented, use {!waitpid}. *)
val waitpid : wait_flag list -> int -> int * process_status
-(** Same as {!Unix.wait}, but waits for the child process whose pid is given.
+(** Same as {!wait}, but waits for the child process whose pid is given.
A pid of [-1] means wait for any child.
A pid of [0] means wait for any child in the same process group
as the current process.
immediately without waiting, and whether it should report stopped
children.
- On Windows, this function can only wait for a given PID, not any
- child process. *)
+ On Windows: can only wait for a given PID, not any child process. *)
val system : string -> process_status
(** Execute the given command, wait until it terminates, and return
The result [WEXITED 127] indicates that the shell couldn't be
executed. *)
+val _exit : int -> 'a
+(** Terminate the calling process immediately, returning the given
+ status code to the operating system: usually 0 to indicate no
+ errors, and a small positive integer to indicate failure.
+ Unlike {!Stdlib.exit}, {!Unix._exit} performs no finalization
+ whatsoever: functions registered with {!Stdlib.at_exit} are not called,
+ input/output channels are not flushed, and the C run-time system
+ is not finalized either.
+
+ The typical use of {!Unix._exit} is after a {!Unix.fork} operation,
+ when the child process runs into a fatal error and must exit. In
+ this case, it is preferable to not perform any finalization action
+ in the child process, as these actions could interfere with similar
+ actions performed by the parent process. For example, output
+ channels should not be flushed by the child process, as the parent
+ process may flush them again later, resulting in duplicate
+ output.
+
+ @since 4.12.0 *)
+
val getpid : unit -> int
(** Return the pid of the process. *)
val getppid : unit -> int
(** Return the pid of the parent process.
- On Windows: not implemented (because it is meaningless). *)
+
+ On Windows: not implemented (because it is meaningless). *)
val nice : int -> int
(** Change the process priority. The integer argument is added to the
On Windows: not implemented. *)
-
(** {1 Basic file input/output} *)
| O_EXCL (** Fail if existing *)
| O_NOCTTY (** Don't make this dev a controlling tty *)
| O_DSYNC (** Writes complete as `Synchronised I/O data
- integrity completion' *)
+ integrity completion' *)
| O_SYNC (** Writes complete as `Synchronised I/O file
- integrity completion' *)
- | O_RSYNC (** Reads complete as writes (depending on
- O_SYNC/O_DSYNC) *)
+ integrity completion' *)
+ | O_RSYNC (** Reads complete as writes (depending
+ on O_SYNC/O_DSYNC) *)
| O_SHARE_DELETE (** Windows only: allow the file to be deleted
- while still open *)
+ while still open *)
| O_CLOEXEC (** Set the close-on-exec flag on the
descriptor returned by {!openfile}.
See {!set_close_on_exec} for more
information. *)
| O_KEEPEXEC (** Clear the close-on-exec flag.
This is currently the default. *)
-(** The flags to {!Unix.openfile}. *)
+(** The flags to {!openfile}. *)
type file_perm = int
(** Close a file descriptor. *)
val fsync : file_descr -> unit
-(** Flush file buffers to disk. *)
+(** Flush file buffers to disk.
+
+ @since 4.08.0 (4.12.0 in UnixLabels) *)
val read : file_descr -> bytes -> int -> int -> int
-(** [read fd buff ofs len] reads [len] bytes from descriptor [fd],
- storing them in byte sequence [buff], starting at position [ofs] in
- [buff]. Return the number of bytes actually read. *)
+(** [read fd buf pos len] reads [len] bytes from descriptor [fd],
+ storing them in byte sequence [buf], starting at position [pos] in
+ [buf]. Return the number of bytes actually read. *)
val write : file_descr -> bytes -> int -> int -> int
-(** [write fd buff ofs len] writes [len] bytes to descriptor [fd],
- taking them from byte sequence [buff], starting at position [ofs]
+(** [write fd buf pos len] writes [len] bytes to descriptor [fd],
+ taking them from byte sequence [buf], starting at position [pos]
in [buff]. Return the number of bytes actually written. [write]
repeats the writing operation until all bytes have been written or
an error occurs. *)
val single_write : file_descr -> bytes -> int -> int -> int
-(** Same as [write], but attempts to write only once.
+(** Same as {!write}, but attempts to write only once.
Thus, if an error occurs, [single_write] guarantees that no data
has been written. *)
val write_substring : file_descr -> string -> int -> int -> int
-(** Same as [write], but take the data from a string instead of a byte
+(** Same as {!write}, but take the data from a string instead of a byte
sequence.
@since 4.02.0 *)
-val single_write_substring : file_descr -> string -> int -> int -> int
-(** Same as [single_write], but take the data from a string instead of
+val single_write_substring :
+ file_descr -> string -> int -> int -> int
+(** Same as {!single_write}, but take the data from a string instead of
a byte sequence.
@since 4.02.0 *)
[set_binary_mode_in ic false] if text mode is desired.
Text mode is supported only if the descriptor refers to a file
or pipe, but is not supported if it refers to a socket.
- On Windows, [set_binary_mode_in] always fails on channels created
+
+ On Windows: [set_binary_mode_in] always fails on channels created
with this function.
Beware that channels are buffered so more characters may have been
[set_binary_mode_out oc false] if text mode is desired.
Text mode is supported only if the descriptor refers to a file
or pipe, but is not supported if it refers to a socket.
- On Windows, [set_binary_mode_out] always fails on channels created
+
+ On Windows: [set_binary_mode_out] always fails on channels created
with this function.
Beware that channels are buffered so you may have to [flush] them
SEEK_SET (** indicates positions relative to the beginning of the file *)
| SEEK_CUR (** indicates positions relative to the current position *)
| SEEK_END (** indicates positions relative to the end of the file *)
-(** Positioning modes for {!Unix.lseek}. *)
+(** Positioning modes for {!lseek}. *)
val lseek : file_descr -> int -> seek_command -> int
st_mtime : float; (** Last modification time *)
st_ctime : float; (** Last status change time *)
}
-(** The information returned by the {!Unix.stat} calls. *)
+(** The information returned by the {!stat} calls. *)
val stat : string -> stats
(** Return the information for the named file. *)
val lstat : string -> stats
-(** Same as {!Unix.stat}, but in case the file is a symbolic link,
+(** Same as {!stat}, but in case the file is a symbolic link,
return the information for the link itself. *)
val fstat : file_descr -> stats
module LargeFile :
sig
val lseek : file_descr -> int64 -> seek_command -> int64
- (** See {!Unix.lseek}. *)
+ (** See [lseek]. *)
val truncate : string -> int64 -> unit
- (** See {!Unix.truncate}. *)
+ (** See [truncate]. *)
val ftruncate : file_descr -> int64 -> unit
- (** See {!Unix.ftruncate}. *)
+ (** See [ftruncate]. *)
type stats =
{ st_dev : int; (** Device number *)
end
(** File operations on large files.
This sub-module provides 64-bit variants of the functions
- {!Unix.lseek} (for positioning a file descriptor),
- {!Unix.truncate} and {!Unix.ftruncate} (for changing the size of a file),
- and {!Unix.stat}, {!Unix.lstat} and {!Unix.fstat} (for obtaining
- information on files). These alternate functions represent
+ {!lseek} (for positioning a file descriptor),
+ {!truncate} and {!ftruncate}
+ (for changing the size of a file),
+ and {!stat}, {!lstat} and {!fstat}
+ (for obtaining information on files). These alternate functions represent
positions and sizes by 64-bit integers (type [int64]) instead of
regular integers (type [int]), thus allowing operating on files
whose sizes are greater than [max_int]. *)
(** {1 Mapping files into memory} *)
val map_file :
- file_descr -> ?pos:int64 -> ('a, 'b) Stdlib.Bigarray.kind ->
+ file_descr ->
+ ?pos (* thwart tools/sync_stdlib_docs *):int64 ->
+ ('a, 'b) Stdlib.Bigarray.kind ->
'c Stdlib.Bigarray.layout -> bool -> int array ->
('a, 'b, 'c) Stdlib.Bigarray.Genarray.t
(** Memory mapping of a file as a Bigarray.
and dimensions as specified in [dims]. The data contained in
this Bigarray are the contents of the file referred to by
the file descriptor [fd] (as opened previously with
- [Unix.openfile], for example). The optional [pos] parameter
+ {!openfile}, for example). The optional [pos] parameter
is the byte offset in the file of the data being mapped;
it defaults to 0 (map from the beginning of the file).
*)
val rename : string -> string -> unit
-(** [rename old new] changes the name of a file from [old] to [new],
- moving it between directories if needed. If [new] already
- exists, its contents will be replaced with those of [old].
+(** [rename src dst] changes the name of a file from [src] to [dst],
+ moving it between directories if needed. If [dst] already
+ exists, its contents will be replaced with those of [src].
Depending on the operating system, the metadata (permissions,
- owner, etc) of [new] can either be preserved or be replaced by
- those of [old]. *)
+ owner, etc) of [dst] can either be preserved or be replaced by
+ those of [src]. *)
-val link : ?follow:bool -> string -> string -> unit
-(** [link ?follow source dest] creates a hard link named [dest] to the file
- named [source].
+val link : ?follow (* thwart tools/sync_stdlib_docs *) :bool ->
+ string -> string -> unit
+(** [link ?follow src dst] creates a hard link named [dst] to the file
+ named [src].
- @param follow indicates whether a [source] symlink is followed or a
- hardlink to [source] itself will be created. On {e Unix} systems this is
+ @param follow indicates whether a [src] symlink is followed or a
+ hardlink to [src] itself will be created. On {e Unix} systems this is
done using the [linkat(2)] function. If [?follow] is not provided, then the
[link(2)] function is used whose behaviour is OS-dependent, but more widely
available.
| W_OK (** Write permission *)
| X_OK (** Execution permission *)
| F_OK (** File exists *)
-(** Flags for the {!Unix.access} call. *)
+(** Flags for the {!access} call. *)
val chmod : string -> file_perm -> unit
val fchmod : file_descr -> file_perm -> unit
(** Change the permissions of an opened file.
+
On Windows: not implemented. *)
val chown : string -> int -> int -> unit
(** Change the owner uid and owner gid of the named file.
- On Windows: not implemented (make no sense on a DOS file system). *)
+
+ On Windows: not implemented. *)
val fchown : file_descr -> int -> int -> unit
(** Change the owner uid and owner gid of an opened file.
- On Windows: not implemented (make no sense on a DOS file system). *)
+
+ On Windows: not implemented. *)
val umask : int -> int
(** Set the process's file mode creation mask, and return the previous
mask.
+
On Windows: not implemented. *)
val access : string -> access_permission list -> unit
(** Check that the process has the given permissions over the named file.
- @raise Unix_error otherwise.
- On Windows, execute permission [X_OK], cannot be tested, it just
- tests for read permission instead. *)
+ On Windows: execute permission [X_OK] cannot be tested, just
+ tests for read permission instead.
+
+ @raise Unix_error otherwise.
+ *)
(** {1 Operations on file descriptors} *)
-val dup : ?cloexec:bool -> file_descr -> file_descr
+val dup : ?cloexec: (* thwart tools/sync_stdlib_docs *) bool ->
+ file_descr -> file_descr
(** Return a new file descriptor referencing the same file as
the given descriptor.
See {!set_close_on_exec} for documentation on the [cloexec]
optional argument. *)
-val dup2 : ?cloexec:bool -> file_descr -> file_descr -> unit
-(** [dup2 fd1 fd2] duplicates [fd1] to [fd2], closing [fd2] if already
+val dup2 : ?cloexec: (* thwart tools/sync_stdlib_docs *) bool ->
+ file_descr -> file_descr -> unit
+(** [dup2 src dst] duplicates [src] to [dst], closing [dst] if already
opened.
See {!set_close_on_exec} for documentation on the [cloexec]
optional argument. *)
val clear_nonblock : file_descr -> unit
(** Clear the ``non-blocking'' flag on the given descriptor.
- See {!Unix.set_nonblock}.*)
+ See {!set_nonblock}.*)
val set_close_on_exec : file_descr -> unit
(** Set the ``close-on-exec'' flag on the given descriptor.
val clear_close_on_exec : file_descr -> unit
(** Clear the ``close-on-exec'' flag on the given descriptor.
- See {!Unix.set_close_on_exec}.*)
+ See {!set_close_on_exec}.*)
(** {1 Directories} *)
val chroot : string -> unit
(** Change the process root directory.
+
On Windows: not implemented. *)
type dir_handle
(** {1 Pipes and redirections} *)
-val pipe : ?cloexec:bool -> unit -> file_descr * file_descr
+val pipe : ?cloexec: (* thwart tools/sync_stdlib_docs *) bool ->
+ unit -> file_descr * file_descr
(** Create a pipe. The first component of the result is opened
for reading, that's the exit to the pipe. The second component is
opened for writing, that's the entrance to the pipe.
val mkfifo : string -> file_perm -> unit
(** Create a named pipe with the given permissions (see {!umask}).
+
On Windows: not implemented. *)
val create_process :
- string -> string array -> file_descr -> file_descr -> file_descr -> int
-(** [create_process prog args new_stdin new_stdout new_stderr]
+ string -> string array -> file_descr -> file_descr ->
+ file_descr -> int
+(** [create_process prog args stdin stdout stderr]
forks a new process that executes the program
in file [prog], with arguments [args]. The pid of the new
process is returned immediately; the new process executes
concurrently with the current process.
The standard input and outputs of the new process are connected
- to the descriptors [new_stdin], [new_stdout] and [new_stderr].
- Passing e.g. [stdout] for [new_stdout] prevents the redirection
+ to the descriptors [stdin], [stdout] and [stderr].
+ Passing e.g. [Stdlib.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.
The new process has the same environment as the current process. *)
val create_process_env :
- string -> string array -> string array -> file_descr -> file_descr ->
- file_descr -> int
-(** [create_process_env prog args env new_stdin new_stdout new_stderr]
- works as {!Unix.create_process}, except that the extra argument
+ string -> string array -> string array -> file_descr ->
+ file_descr -> file_descr -> int
+(** [create_process_env prog args env stdin stdout stderr]
+ works as {!create_process}, except that the extra argument
[env] specifies the environment passed to the program. *)
The standard output of the command is redirected to a pipe,
which can be read via the returned input channel.
The command is interpreted by the shell [/bin/sh]
- (or [cmd.exe] on Windows), cf. {!Unix.system}.
+ (or [cmd.exe] on Windows), cf. {!system}.
The {!Filename.quote_command} function can be used to
quote the command and its arguments as appropriate for the shell being
used. If the command does not need to be run through the shell,
- {!Unix.open_process_args_in} can be used as a more robust and
- more efficient alternative to {!Unix.open_process_in}. *)
+ {!open_process_args_in} can be used as a more robust and
+ more efficient alternative to {!open_process_in}. *)
val open_process_out : string -> out_channel
-(** Same as {!Unix.open_process_in}, but redirect the standard input of
+(** Same as {!open_process_in}, but redirect the standard input of
the command to a pipe. Data written to the returned output channel
is sent to the standard input of the command.
Warning: writes on output channels are buffered, hence be careful
to call {!Stdlib.flush} at the right times to ensure
correct synchronization.
If the command does not need to be run through the shell,
- {!Unix.open_process_args_out} can be used instead of
- {!Unix.open_process_out}. *)
+ {!open_process_args_out} can be used instead of
+ {!open_process_out}. *)
val open_process : string -> in_channel * out_channel
-(** Same as {!Unix.open_process_out}, but redirects both the standard input
+(** Same as {!open_process_out}, but redirects both the standard input
and standard output of the command to pipes connected to the two
returned channels. The input channel is connected to the output
of the command, and the output channel to the input of the command.
If the command does not need to be run through the shell,
- {!Unix.open_process_args} can be used instead of
- {!Unix.open_process}. *)
+ {!open_process_args} can be used instead of
+ {!open_process}. *)
val open_process_full :
string -> string array -> in_channel * out_channel * in_channel
-(** Similar to {!Unix.open_process}, but the second argument specifies
+(** Similar to {!open_process}, but the second argument specifies
the environment passed to the command. The result is a triple
of channels connected respectively to the standard output, standard input,
and standard error of the command.
If the command does not need to be run through the shell,
- {!Unix.open_process_args_full} can be used instead of
- {!Unix.open_process_full}. *)
+ {!open_process_args_full} can be used instead of
+ {!open_process_full}. *)
val open_process_args_in : string -> string array -> in_channel
(** High-level pipe and process management. The first argument specifies the
@since 4.08.0 *)
val open_process_args_out : string -> string array -> out_channel
-(** Same as {!Unix.open_process_args_in}, but redirect the standard input of the
+(** Same as {!open_process_args_in}, but redirect the standard input of the
command to a pipe. Data written to the returned output channel is sent to
the standard input of the command. Warning: writes on output channels are
buffered, hence be careful to call {!Stdlib.flush} at the right times to
@since 4.08.0 *)
val open_process_args : string -> string array -> in_channel * out_channel
-(** Same as {!Unix.open_process_args_out}, but redirects both the standard input
+(** Same as {!open_process_args_out}, but redirects both the standard input
and standard output of the command to pipes connected to the two returned
channels. The input channel is connected to the output of the command, and
the output channel to the input of the command.
val open_process_args_full :
string -> string array -> string array ->
in_channel * out_channel * in_channel
-(** Similar to {!Unix.open_process_args}, but the third argument specifies the
+(** Similar to {!open_process_args}, but the third argument specifies the
environment passed to the command. The result is a triple of channels
connected respectively to the standard output, standard input, and standard
error of the command.
@since 4.08.0 *)
val process_in_pid : in_channel -> int
-(** Return the pid of a process opened via {!Unix.open_process_in} or
- {!Unix.open_process_args_in}.
+(** Return the pid of a process opened via {!open_process_in} or
+ {!open_process_args_in}.
- @since 4.08.0 *)
+ @since 4.08.0 (4.12.0 in UnixLabels) *)
val process_out_pid : out_channel -> int
-(** Return the pid of a process opened via {!Unix.open_process_out} or
- {!Unix.open_process_args_out}.
+(** Return the pid of a process opened via {!open_process_out} or
+ {!open_process_args_out}.
- @since 4.08.0 *)
+ @since 4.08.0 (4.12.0 in UnixLabels) *)
val process_pid : in_channel * out_channel -> int
-(** Return the pid of a process opened via {!Unix.open_process} or
- {!Unix.open_process_args}.
+(** Return the pid of a process opened via {!open_process} or
+ {!open_process_args}.
- @since 4.08.0 *)
+ @since 4.08.0 (4.12.0 in UnixLabels) *)
val process_full_pid : in_channel * out_channel * in_channel -> int
-(** Return the pid of a process opened via {!Unix.open_process_full} or
- {!Unix.open_process_args_full}.
+(** Return the pid of a process opened via {!open_process_full} or
+ {!open_process_args_full}.
- @since 4.08.0 *)
+ @since 4.08.0 (4.12.0 in UnixLabels) *)
val close_process_in : in_channel -> process_status
-(** Close channels opened by {!Unix.open_process_in},
+(** Close channels opened by {!open_process_in},
wait for the associated command to terminate,
and return its termination status. *)
val close_process_out : out_channel -> process_status
-(** Close channels opened by {!Unix.open_process_out},
+(** Close channels opened by {!open_process_out},
wait for the associated command to terminate,
and return its termination status. *)
val close_process : in_channel * out_channel -> process_status
-(** Close channels opened by {!Unix.open_process},
+(** Close channels opened by {!open_process},
wait for the associated command to terminate,
and return its termination status. *)
val close_process_full :
in_channel * out_channel * in_channel -> process_status
-(** Close channels opened by {!Unix.open_process_full},
+(** Close channels opened by {!open_process_full},
wait for the associated command to terminate,
and return its termination status. *)
(** {1 Symbolic links} *)
-val symlink : ?to_dir:bool -> string -> string -> unit
-(** [symlink ?to_dir source dest] creates the file [dest] as a symbolic link
- to the file [source]. On Windows, [~to_dir] indicates if the symbolic link
- points to a directory or a file; if omitted, [symlink] examines [source]
- using [stat] and picks appropriately, if [source] does not exist then [false]
- is assumed (for this reason, it is recommended that the [~to_dir] parameter
- be specified in new code). On Unix, [~to_dir] is ignored.
+val symlink : ?to_dir: (* thwart tools/sync_stdlib_docs *) bool ->
+ string -> string -> unit
+(** [symlink ?to_dir src dst] creates the file [dst] as a symbolic link
+ to the file [src]. On Windows, [to_dir] indicates if the symbolic link
+ points to a directory or a file; if omitted, [symlink] examines [src]
+ using [stat] and picks appropriately, if [src] does not exist then [false]
+ is assumed (for this reason, it is recommended that the [to_dir] parameter
+ be specified in new code). On Unix, [to_dir] is ignored.
Windows symbolic links are available in Windows Vista onwards. There are some
important differences between Windows symlinks and their POSIX counterparts.
SeCreateSymbolicLinkPrivilege via Local Security Policy (secpol.msc) or via
Active Directory.
- {!has_symlink} can be used to check that a process is able to create symbolic
- links. *)
+ {!has_symlink} can be used to check that a process is able to create
+ symbolic links. *)
val has_symlink : unit -> bool
(** Returns [true] if the user is able to create symbolic links. On Windows,
val select :
- file_descr list -> file_descr list -> file_descr list -> float ->
- file_descr list * file_descr list * file_descr list
+ file_descr list -> file_descr list -> file_descr list ->
+ float -> file_descr list * file_descr list * file_descr list
(** Wait until some input/output operations become possible on
some channels. The three list arguments are, respectively, a set
of descriptors to check for reading (first argument), for writing
and over which an exceptional condition is pending (third
component). *)
-
(** {1 Locking} *)
type lock_command =
| F_TEST (** Test a region for other process locks *)
| F_RLOCK (** Lock a region for reading, and block if already locked *)
| F_TRLOCK (** Lock a region for reading, or fail if already locked *)
-(** Commands for {!Unix.lockf}. *)
+(** Commands for {!lockf}. *)
val lockf : file_descr -> lock_command -> int -> unit
-(** [lockf fd cmd size] puts a lock on a region of the file opened
+(** [lockf fd mode len] puts a lock on a region of the file opened
as [fd]. The region starts at the current read/write position for
- [fd] (as set by {!Unix.lseek}), and extends [size] bytes forward if
- [size] is positive, [size] bytes backwards if [size] is negative,
- or to the end of the file if [size] is zero.
+ [fd] (as set by {!lseek}), and extends [len] bytes forward if
+ [len] is positive, [len] bytes backwards if [len] is negative,
+ or to the end of the file if [len] is zero.
A write lock prevents any other
process from acquiring a read or write lock on the region.
A read lock prevents any other
already locked by the same process depends on the OS. On POSIX-compliant
systems, the second lock operation succeeds and may "promote" the older
lock from read lock to write lock. On Windows, the second lock
- operation will block or fail.
-*)
+ operation will block or fail. *)
(** {1 Signals}
*)
val kill : int -> int -> unit
-(** [kill pid sig] sends signal number [sig] to the process
- with id [pid]. On Windows, only the {!Sys.sigkill} signal
- is emulated. *)
+(** [kill pid signal] sends signal number [signal] to the process
+ with id [pid].
+
+ On Windows: only the {!Sys.sigkill} signal is emulated. *)
type sigprocmask_command =
SIG_SETMASK
| SIG_UNBLOCK
val sigprocmask : sigprocmask_command -> int list -> int list
-(** [sigprocmask cmd sigs] changes the set of blocked signals.
- If [cmd] is [SIG_SETMASK], blocked signals are set to those in
+(** [sigprocmask mode sigs] changes the set of blocked signals.
+ If [mode] is [SIG_SETMASK], blocked signals are set to those in
the list [sigs].
- If [cmd] is [SIG_BLOCK], the signals in [sigs] are added to
+ If [mode] is [SIG_BLOCK], the signals in [sigs] are added to
the set of blocked signals.
- If [cmd] is [SIG_UNBLOCK], the signals in [sigs] are removed
+ If [mode] is [SIG_UNBLOCK], the signals in [sigs] are removed
from the set of blocked signals.
[sigprocmask] returns the set of previously blocked signals.
in seconds. *)
val gettimeofday : unit -> float
-(** Same as {!Unix.time}, but with resolution better than 1 second. *)
+(** Same as {!time}, but with resolution better than 1 second. *)
val gmtime : float -> tm
-(** Convert a time in seconds, as returned by {!Unix.time}, into a date and
+(** Convert a time in seconds, as returned by {!time}, into a date and
a time. Assumes UTC (Coordinated Universal Time), also known as GMT.
To perform the inverse conversion, set the TZ environment variable
to "UTC", use {!mktime}, and then restore the original value of TZ. *)
val localtime : float -> tm
-(** Convert a time in seconds, as returned by {!Unix.time}, into a date and
+(** Convert a time in seconds, as returned by {!time}, into a date and
a time. Assumes the local time zone.
The function performing the inverse conversion is {!mktime}. *)
val mktime : tm -> float * tm
(** Convert a date and time, specified by the [tm] argument, into
- a time in seconds, as returned by {!Unix.time}. The [tm_isdst],
+ a time in seconds, as returned by {!time}. The [tm_isdst],
[tm_wday] and [tm_yday] fields of [tm] are ignored. Also return a
normalized copy of the given [tm] record, with the [tm_wday],
[tm_yday], and [tm_isdst] fields recomputed from the other fields,
(** Stop execution for the given number of seconds. Like [sleep],
but fractions of seconds are supported.
- @since 4.03.0 *)
+ @since 4.03.0 (4.12.0 in UnixLabels) *)
val times : unit -> process_times
(** Return the execution times of the process.
- On Windows, it is partially implemented, will not report timings
+
+ On Windows: partially implemented, will not report timings
for child processes. *)
val utimes : string -> float -> float -> unit
type interval_timer =
ITIMER_REAL
(** decrements in real time, and sends the signal [SIGALRM] when
- expired.*)
+ expired.*)
| ITIMER_VIRTUAL
- (** decrements in process virtual time, and sends [SIGVTALRM]
- when expired. *)
+ (** decrements in process virtual time, and sends [SIGVTALRM] when
+ expired. *)
| ITIMER_PROF
(** (for profiling) decrements both when the process
is running and when the system is running on behalf of the
(** {1 User id, group id} *)
-
val getuid : unit -> int
(** Return the user id of the user executing the process.
- On Windows, always return [1]. *)
+
+ On Windows: always returns [1]. *)
val geteuid : unit -> int
(** Return the effective user id under which the process runs.
- On Windows, always return [1]. *)
+
+ On Windows: always returns [1]. *)
val setuid : int -> unit
(** Set the real user id and effective user id for the process.
+
On Windows: not implemented. *)
val getgid : unit -> int
(** Return the group id of the user executing the process.
- On Windows, always return [1]. *)
+
+ On Windows: always returns [1]. *)
val getegid : unit -> int
(** Return the effective group id under which the process runs.
- On Windows, always return [1]. *)
+
+ On Windows: always returns [1]. *)
val setgid : int -> unit
(** Set the real group id and effective group id for the process.
+
On Windows: not implemented. *)
val getgroups : unit -> int array
(** Return the list of groups to which the user executing the process
belongs.
- On Windows, always return [[|1|]]. *)
+
+ On Windows: always returns [[|1|]]. *)
val setgroups : int array -> unit
(** [setgroups groups] sets the supplementary group IDs for the
calling process. Appropriate privileges are required.
+
On Windows: not implemented. *)
val initgroups : string -> int -> unit
reading the group database /etc/group and using all groups of
which [user] is a member. The additional group [group] is also
added to the list.
+
On Windows: not implemented. *)
type passwd_entry =
val getpwnam : string -> passwd_entry
(** Find an entry in [passwd] with the given name.
- @raise Not_found if no such entry exist.
-
- On Windows, always raise [Not_found]. *)
+ @raise Not_found if no such entry exists, or always on Windows. *)
val getgrnam : string -> group_entry
(** Find an entry in [group] with the given name.
- @raise Not_found if no such entry exist.
- On Windows, always raise [Not_found]. *)
+ @raise Not_found if no such entry exists, or always on Windows. *)
val getpwuid : int -> passwd_entry
(** Find an entry in [passwd] with the given user id.
- @raise Not_found if no such entry exist.
- On Windows, always raise [Not_found]. *)
+ @raise Not_found if no such entry exists, or always on Windows. *)
val getgrgid : int -> group_entry
(** Find an entry in [group] with the given group id.
- @raise Not_found if no such entry exist.
- On Windows, always raise [Not_found]. *)
+ @raise Not_found if no such entry exists, or always on Windows. *)
(** {1 Internet addresses} *)
val string_of_inet_addr : inet_addr -> string
(** Return the printable representation of the given Internet address.
- See {!Unix.inet_addr_of_string} for a description of the
+ See {!inet_addr_of_string} for a description of the
printable representation. *)
val inet_addr_any : inet_addr
val inet6_addr_loopback : inet_addr
(** A special IPv6 address representing the host machine ([::1]). *)
+val is_inet6_addr : inet_addr -> bool
+(** Whether the given [inet_addr] is an IPv6 address.
+ @since 4.12.0 *)
(** {1 Sockets} *)
| PF_INET (** Internet domain (IPv4) *)
| PF_INET6 (** Internet domain (IPv6) *)
(** The type of socket domains. Not all platforms support
- IPv6 sockets (type [PF_INET6]). Windows does not support
- [PF_UNIX]. *)
+ IPv6 sockets (type [PF_INET6]).
+
+ On Windows: [PF_UNIX] not implemented. *)
type socket_type =
SOCK_STREAM (** Stream socket *)
[port] is the port number. *)
val socket :
- ?cloexec:bool -> socket_domain -> socket_type -> int -> file_descr
+ ?cloexec: (* thwart tools/sync_stdlib_docs *) bool ->
+ socket_domain -> socket_type -> int -> file_descr
(** Create a new socket in the given domain, and with the
given kind. The third argument is the protocol type; 0 selects
the default protocol for that kind of sockets.
(** Return the socket domain adequate for the given socket address. *)
val socketpair :
- ?cloexec:bool -> socket_domain -> socket_type -> int ->
- file_descr * file_descr
+ ?cloexec: (* thwart tools/sync_stdlib_docs *) bool ->
+ socket_domain -> socket_type -> int ->
+ file_descr * file_descr
(** Create a pair of unnamed sockets, connected together.
See {!set_close_on_exec} for documentation on the [cloexec]
optional argument. *)
-val accept : ?cloexec:bool -> file_descr -> file_descr * sockaddr
+val accept : ?cloexec: (* thwart tools/sync_stdlib_docs *) bool ->
+ file_descr -> file_descr * sockaddr
(** Accept connections on the given socket. The returned descriptor
is a socket connected to the client; the returned address is
the address of the connecting client.
MSG_OOB
| MSG_DONTROUTE
| MSG_PEEK (**)
-(** The flags for {!Unix.recv}, {!Unix.recvfrom},
- {!Unix.send} and {!Unix.sendto}. *)
+(** The flags for {!recv}, {!recvfrom}, {!send} and {!sendto}. *)
-val recv : file_descr -> bytes -> int -> int -> msg_flag list -> int
+val recv :
+ file_descr -> bytes -> int -> int -> msg_flag list -> int
(** Receive data from a connected socket. *)
val recvfrom :
- file_descr -> bytes -> int -> int -> msg_flag list -> int * sockaddr
+ file_descr -> bytes -> int -> int -> msg_flag list ->
+ int * sockaddr
(** Receive data from an unconnected socket. *)
-val send : file_descr -> bytes -> int -> int -> msg_flag list -> int
+val send :
+ file_descr -> bytes -> int -> int -> msg_flag list -> int
(** Send data over a connected socket. *)
-val send_substring : file_descr -> string -> int -> int -> msg_flag list -> int
+val send_substring :
+ file_descr -> string -> int -> int -> msg_flag list -> int
(** Same as [send], but take the data from a string instead of a byte
sequence.
@since 4.02.0 *)
val sendto :
- file_descr -> bytes -> int -> int -> msg_flag list -> sockaddr -> int
+ file_descr -> bytes -> int -> int -> msg_flag list ->
+ sockaddr -> int
(** Send data over an unconnected socket. *)
val sendto_substring :
- file_descr -> string -> int -> int -> msg_flag list -> sockaddr -> int
+ file_descr -> string -> int -> int -> msg_flag list
+ -> sockaddr -> int
(** Same as [sendto], but take the data from a string instead of a
byte sequence.
@since 4.02.0 *)
+
(** {1 Socket options} *)
| SO_ACCEPTCONN (** Report whether socket listening is enabled *)
| TCP_NODELAY (** Control the Nagle algorithm for TCP sockets *)
| IPV6_ONLY (** Forbid binding an IPv6 socket to an IPv4 address *)
-(** The socket options that can be consulted with {!Unix.getsockopt}
- and modified with {!Unix.setsockopt}. These options have a boolean
+ | SO_REUSEPORT (** Allow reuse of address and port bindings *)
+(** The socket options that can be consulted with {!getsockopt}
+ and modified with {!setsockopt}. These options have a boolean
([true]/[false]) value. *)
type socket_int_option =
- SO_SNDBUF (** Size of send buffer *)
- | SO_RCVBUF (** Size of received buffer *)
- | SO_ERROR (** Deprecated. Use {!Unix.getsockopt_error} instead. *)
- | SO_TYPE (** Report the socket type *)
- | SO_RCVLOWAT (** Minimum number of bytes to process for input operations*)
- | SO_SNDLOWAT (** Minimum number of bytes to process for output
- operations *)
-(** The socket options that can be consulted with {!Unix.getsockopt_int}
- and modified with {!Unix.setsockopt_int}. These options have an
+ SO_SNDBUF (** Size of send buffer *)
+ | SO_RCVBUF (** Size of received buffer *)
+ | SO_ERROR (** Deprecated. Use {!getsockopt_error} instead. *)
+ | SO_TYPE (** Report the socket type *)
+ | SO_RCVLOWAT (** Minimum number of bytes to process for input operations *)
+ | SO_SNDLOWAT (** Minimum number of bytes to process for output operations *)
+(** The socket options that can be consulted with {!getsockopt_int}
+ and modified with {!setsockopt_int}. These options have an
integer value. *)
type socket_optint_option =
SO_LINGER (** Whether to linger on closed connections
that have data present, and for how long
(in seconds) *)
-(** The socket options that can be consulted with {!Unix.getsockopt_optint}
- and modified with {!Unix.setsockopt_optint}. These options have a
+(** The socket options that can be consulted with {!getsockopt_optint}
+ and modified with {!setsockopt_optint}. These options have a
value of type [int option], with [None] meaning ``disabled''. *)
type socket_float_option =
SO_RCVTIMEO (** Timeout for input operations *)
| SO_SNDTIMEO (** Timeout for output operations *)
-(** The socket options that can be consulted with {!Unix.getsockopt_float}
- and modified with {!Unix.setsockopt_float}. These options have a
+(** The socket options that can be consulted with {!getsockopt_float}
+ and modified with {!setsockopt_float}. These options have a
floating-point value representing a time in seconds.
The value 0 means infinite timeout. *)
(** Set or clear a boolean-valued option in the given socket. *)
val getsockopt_int : file_descr -> socket_int_option -> int
-(** Same as {!Unix.getsockopt} for an integer-valued socket option. *)
+(** Same as {!getsockopt} for an integer-valued socket option. *)
val setsockopt_int : file_descr -> socket_int_option -> int -> unit
-(** Same as {!Unix.setsockopt} for an integer-valued socket option. *)
+(** Same as {!setsockopt} for an integer-valued socket option. *)
val getsockopt_optint : file_descr -> socket_optint_option -> int option
-(** Same as {!Unix.getsockopt} for a socket option whose value is an
- [int option]. *)
+(** Same as {!getsockopt} for a socket option whose value is
+ an [int option]. *)
val setsockopt_optint :
file_descr -> socket_optint_option -> int option -> unit
-(** Same as {!Unix.setsockopt} for a socket option whose value is an
- [int option]. *)
+(** Same as {!setsockopt} for a socket option whose value is
+ an [int option]. *)
val getsockopt_float : file_descr -> socket_float_option -> float
-(** Same as {!Unix.getsockopt} for a socket option whose value is a
- floating-point number. *)
+(** Same as {!getsockopt} for a socket option whose value is a
+ floating-point number. *)
val setsockopt_float : file_descr -> socket_float_option -> float -> unit
-(** Same as {!Unix.setsockopt} for a socket option whose value is a
- floating-point number. *)
+(** Same as {!setsockopt} for a socket option whose value is a
+ floating-point number. *)
val getsockopt_error : file_descr -> error option
(** Return the error condition associated with the given socket,
and clear it. *)
-
(** {1 High-level network connection functions} *)
times to ensure correct synchronization. *)
val shutdown_connection : in_channel -> unit
-(** ``Shut down'' a connection established with {!Unix.open_connection};
+(** ``Shut down'' a connection established with {!open_connection};
that is, transmit an end-of-file condition to the server reading
on the other side of the connection. This does not fully close the
file descriptor associated with the channel, which you must remember
to free via {!Stdlib.close_in}. *)
-val establish_server : (in_channel -> out_channel -> unit) -> sockaddr -> unit
+val establish_server :
+ (in_channel -> out_channel -> unit) -> sockaddr -> unit
(** Establish a server on the given address.
The function given as first argument is called for each connection
with two buffered channels connected to the client. A new process
- is created for each connection. The function {!Unix.establish_server}
+ is created for each connection. The function {!establish_server}
never returns normally.
- On Windows, it is not implemented. Use threads. *)
+ On Windows: not implemented (use threads). *)
(** {1 Host and protocol databases} *)
-
type host_entry =
{ h_name : string;
h_aliases : string array;
val gethostbyname : string -> host_entry
(** Find an entry in [hosts] with the given name.
- @raise Not_found if no such entry exist. *)
+ @raise Not_found if no such entry exists. *)
val gethostbyaddr : inet_addr -> host_entry
(** Find an entry in [hosts] with the given address.
- @raise Not_found if no such entry exist. *)
+ @raise Not_found if no such entry exists. *)
val getprotobyname : string -> protocol_entry
(** Find an entry in [protocols] with the given name.
- @raise Not_found if no such entry exist. *)
+ @raise Not_found if no such entry exists. *)
val getprotobynumber : int -> protocol_entry
(** Find an entry in [protocols] with the given protocol number.
- @raise Not_found if no such entry exist. *)
+ @raise Not_found if no such entry exists. *)
val getservbyname : string -> string -> service_entry
(** Find an entry in [services] with the given name.
- @raise Not_found if no such entry exist. *)
+ @raise Not_found if no such entry exists. *)
val getservbyport : int -> string -> service_entry
(** Find an entry in [services] with the given service number.
- @raise Not_found if no such entry exist. *)
+ @raise Not_found if no such entry exists. *)
type addr_info =
{ ai_family : socket_domain; (** Socket domain *)
ai_addr : sockaddr; (** Address *)
ai_canonname : string (** Canonical host name *)
}
-(** Address information returned by {!Unix.getaddrinfo}. *)
+(** Address information returned by {!getaddrinfo}. *)
type getaddrinfo_option =
AI_FAMILY of socket_domain (** Impose the given socket domain *)
| AI_CANONNAME (** Fill the [ai_canonname] field
of the result *)
| AI_PASSIVE (** Set address to ``any'' address
- for use with {!Unix.bind} *)
-(** Options to {!Unix.getaddrinfo}. *)
+ for use with {!bind} *)
+(** Options to {!getaddrinfo}. *)
val getaddrinfo:
string -> string -> getaddrinfo_option list -> addr_info list
-(** [getaddrinfo host service opts] returns a list of {!Unix.addr_info}
+(** [getaddrinfo host service opts] returns a list of {!addr_info}
records describing socket parameters and addresses suitable for
communicating with the given host and service. The empty list is
returned if the host or service names are unknown, or the constraints
{ ni_hostname : string; (** Name or IP address of host *)
ni_service : string; (** Name of service or port number *)
}
-(** Host and service information returned by {!Unix.getnameinfo}. *)
+(** Host and service information returned by {!getnameinfo}. *)
type getnameinfo_option =
NI_NOFQDN (** Do not qualify local host names *)
| NI_NUMERICSERV (** Always return service as port number *)
| NI_DGRAM (** Consider the service as UDP-based
instead of the default TCP *)
-(** Options to {!Unix.getnameinfo}. *)
+(** Options to {!getnameinfo}. *)
val getnameinfo : sockaddr -> getnameinfo_option list -> name_info
(** [getnameinfo addr opts] returns the host name and service name
val tcgetattr : file_descr -> terminal_io
(** Return the status of the terminal referred to by the given
file descriptor.
- On Windows, not implemented. *)
+
+ On Windows: not implemented. *)
type setattr_when =
TCSANOW
the output parameters; [TCSAFLUSH], when changing the input
parameters.
- On Windows, not implemented. *)
+ On Windows: not implemented. *)
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. *)
+ On Windows: not implemented. *)
val tcdrain : file_descr -> unit
(** Waits until all output written on the given file descriptor
has been transmitted.
- On Windows, not implemented. *)
+ On Windows: not implemented. *)
type flush_queue =
TCIFLUSH
[TCOFLUSH] flushes data written but not transmitted, and
[TCIOFLUSH] flushes both.
- On Windows, not implemented. *)
+ On Windows: not implemented. *)
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. *)
+ On Windows: not implemented. *)
val setsid : unit -> int
(** Put the calling process in a new session and detach it from
its controlling terminal.
- On Windows, not implemented. *)
+ On Windows: not implemented. *)
(* *)
(**************************************************************************)
+(* NOTE:
+ If this file is unixLabels.mli, run tools/sync_stdlib_docs after editing it
+ to generate unix.mli.
+
+ If this file is unix.mli, do not edit it directly -- edit unixLabels.mli
+ instead.
+*)
+
+(* NOTE:
+ When a new function is added which is not implemented on Windows (or
+ partially implemented), or the Windows-status of an existing function is
+ changed, remember to update the summary table in
+ manual/manual/library/libunix.etex
+*)
+
(** Interface to the Unix system.
- To use as replacement to default {!Unix} module,
- add [module Unix = UnixLabels] in your implementation.
+
+ To use the labeled version of this module, add [module Unix][ = ][UnixLabels]
+ in your implementation.
+
+ Note: all the functions of this module (except {!error_message} and
+ {!handle_unix_error}) are liable to raise the {!Unix_error}
+ exception whenever the underlying system call signals an error.
*)
(** {1 Error report} *)
(** Raised by the system calls below when an error is encountered.
The first component is the error code; the second component
is the function name; the third component is the string parameter
- to the function, if it has one, or the empty string otherwise. *)
+ to the function, if it has one, or the empty string otherwise.
+
+ {!UnixLabels.Unix_error} and {!Unix.Unix_error} are the same, and
+ catching one will catch the other. *)
val error_message : error -> string
(** Return a string describing the given error code. *)
val handle_unix_error : ('a -> 'b) -> 'a -> 'b
(** [handle_unix_error f x] applies [f] to [x] and returns the result.
- If the exception [Unix_error] is raised, it prints a message
+ If the exception {!Unix_error} is raised, it prints a message
describing the error and exits with code 2. *)
val environment : unit -> string array
(** Return the process environment, as an array of strings
- with the format ``variable=value''. *)
+ with the format ``variable=value''. The returned array
+ is empty if the process has special privileges. *)
+
+val unsafe_environment : unit -> string array
+(** Return the process environment, as an array of strings with the
+ format ``variable=value''. Unlike {!environment}, this function
+ returns a populated array even if the process has special
+ privileges. See the documentation for {!unsafe_getenv} for more
+ details.
+
+ @since 4.06.0 (4.12.0 in UnixLabels) *)
val getenv : string -> string
(** Return the value associated to a variable in the process
- environment. Raise [Not_found] if the variable is unbound.
- (This function is identical to [Sys.getenv].) *)
+ environment, unless the process has special privileges.
+ @raise Not_found if the variable is unbound or the process has
+ special privileges.
+
+ This function is identical to {!Sys.getenv}. *)
val unsafe_getenv : string -> string
(** Return the value associated to a variable in the process
@since 4.06.0 *)
val putenv : string -> string -> unit
-(** [Unix.putenv name value] sets the value associated to a
+(** [putenv name value] sets the value associated to a
variable in the process environment.
[name] is the name of the environment variable,
and [value] its new associated value. *)
type wait_flag = Unix.wait_flag =
- WNOHANG (** do not block if no child has
- died yet, but immediately return with a pid equal to 0.*)
- | WUNTRACED (** report also the children that receive stop signals. *)
-(** Flags for {!UnixLabels.waitpid}. *)
+ WNOHANG (** Do not block if no child has
+ died yet, but immediately return with a pid equal to 0. *)
+ | WUNTRACED (** Report also the children that receive stop signals. *)
+(** Flags for {!waitpid}. *)
val execv : prog:string -> args:string array -> 'a
-(** [execv prog args] execute the program in file [prog], with
+(** [execv ~prog ~args] execute the program in file [prog], with
the arguments [args], and the current process environment.
These [execv*] functions never return: on success, the current
- program is replaced by the new one;
- on failure, a {!UnixLabels.Unix_error} exception is raised. *)
+ program is replaced by the new one.
+ @raise Unix_error on failure *)
val execve : prog:string -> args:string array -> env:string array -> 'a
-(** Same as {!UnixLabels.execv}, except that the third argument provides the
+(** Same as {!execv}, except that the third argument provides the
environment to the program executed. *)
val execvp : prog:string -> args:string array -> 'a
-(** Same as {!UnixLabels.execv}, except that
+(** Same as {!execv}, except that
the program is searched in the path. *)
val execvpe : prog:string -> args:string array -> env:string array -> 'a
-(** Same as {!UnixLabels.execve}, except that
+(** Same as {!execve}, except that
the program is searched in the path. *)
val fork : unit -> int
(** Fork a new process. The returned integer is 0 for the child
- process, the pid of the child process for the parent process. *)
+ process, the pid of the child process for the parent process.
+
+ On Windows: not implemented, use {!create_process} or threads. *)
val wait : unit -> int * process_status
(** Wait until one of the children processes die, and return its pid
- and termination status. *)
+ and termination status.
+
+ On Windows: not implemented, use {!waitpid}. *)
val waitpid : mode:wait_flag list -> int -> int * process_status
-(** Same as {!UnixLabels.wait}, but waits for the child process whose pid
- is given.
+(** Same as {!wait}, but waits for the child process whose pid is given.
A pid of [-1] means wait for any child.
A pid of [0] means wait for any child in the same process group
as the current process.
Negative pid arguments represent process groups.
The list of options indicates whether [waitpid] should return
- immediately without waiting, or also report stopped children. *)
+ immediately without waiting, and whether it should report stopped
+ children.
+
+ On Windows: can only wait for a given PID, not any child process. *)
val system : string -> process_status
(** Execute the given command, wait until it terminates, and return
its termination status. The string is interpreted by the shell
- [/bin/sh] and therefore can contain redirections, quotes, variables,
- etc. The result [WEXITED 127] indicates that the shell couldn't
- be executed. *)
+ [/bin/sh] (or the command interpreter [cmd.exe] on Windows) and
+ therefore can contain redirections, quotes, variables, etc.
+ To properly quote whitespace and shell special characters occurring
+ in file names or command arguments, the use of
+ {!Filename.quote_command} is recommended.
+ The result [WEXITED 127] indicates that the shell couldn't be
+ executed. *)
+
+val _exit : int -> 'a
+(** Terminate the calling process immediately, returning the given
+ status code to the operating system: usually 0 to indicate no
+ errors, and a small positive integer to indicate failure.
+ Unlike {!Stdlib.exit}, {!Unix._exit} performs no finalization
+ whatsoever: functions registered with {!Stdlib.at_exit} are not called,
+ input/output channels are not flushed, and the C run-time system
+ is not finalized either.
+
+ The typical use of {!Unix._exit} is after a {!Unix.fork} operation,
+ when the child process runs into a fatal error and must exit. In
+ this case, it is preferable to not perform any finalization action
+ in the child process, as these actions could interfere with similar
+ actions performed by the parent process. For example, output
+ channels should not be flushed by the child process, as the parent
+ process may flush them again later, resulting in duplicate
+ output.
+
+ @since 4.12.0 *)
val getpid : unit -> int
(** Return the pid of the process. *)
val getppid : unit -> int
-(** Return the pid of the parent process. *)
+(** Return the pid of the parent process.
+
+ On Windows: not implemented (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. *)
+ lower priorities.) Return the new nice value.
+ On Windows: not implemented. *)
(** {1 Basic file input/output} *)
| O_SHARE_DELETE (** Windows only: allow the file to be deleted
while still open *)
| O_CLOEXEC (** Set the close-on-exec flag on the
- descriptor returned by {!openfile} *)
+ descriptor returned by {!openfile}.
+ See {!set_close_on_exec} for more
+ information. *)
| O_KEEPEXEC (** Clear the close-on-exec flag.
This is currently the default. *)
-(** The flags to {!UnixLabels.openfile}. *)
+(** The flags to {!openfile}. *)
type file_perm = int
read for group, none for others *)
val openfile : string -> mode:open_flag list -> perm:file_perm -> file_descr
-(** Open the named file with the given flags. Third argument is
- the permissions to give to the file if it is created. Return
- a file descriptor on the named file. *)
+(** Open the named file with the given flags. Third argument is the
+ permissions to give to the file if it is created (see
+ {!umask}). Return a file descriptor on the named file. *)
val close : file_descr -> unit
(** Close a file descriptor. *)
+val fsync : file_descr -> unit
+(** Flush file buffers to disk.
+
+ @since 4.08.0 (4.12.0 in UnixLabels) *)
+
val read : file_descr -> buf:bytes -> pos:int -> len:int -> int
-(** [read fd buff ofs len] reads [len] bytes from descriptor [fd],
- storing them in byte sequence [buff], starting at position [ofs] in
- [buff]. Return the number of bytes actually read. *)
+(** [read fd ~buf ~pos ~len] reads [len] bytes from descriptor [fd],
+ storing them in byte sequence [buf], starting at position [pos] in
+ [buf]. Return the number of bytes actually read. *)
val write : file_descr -> buf:bytes -> pos:int -> len:int -> int
-(** [write fd buff ofs len] writes [len] bytes to descriptor [fd],
- taking them from byte sequence [buff], starting at position [ofs]
+(** [write fd ~buf ~pos ~len] writes [len] bytes to descriptor [fd],
+ taking them from byte sequence [buf], starting at position [pos]
in [buff]. Return the number of bytes actually written. [write]
repeats the writing operation until all bytes have been written or
an error occurs. *)
val single_write : file_descr -> buf:bytes -> pos:int -> len:int -> int
-(** Same as [write], but attempts to write only once.
+(** Same as {!write}, but attempts to write only once.
Thus, if an error occurs, [single_write] guarantees that no data
has been written. *)
val write_substring : file_descr -> buf:string -> pos:int -> len:int -> int
-(** Same as [write], but take the data from a string instead of a byte
+(** Same as {!write}, but take the data from a string instead of a byte
sequence.
@since 4.02.0 *)
val single_write_substring :
file_descr -> buf:string -> pos:int -> len:int -> int
-(** Same as [single_write], but take the data from a string instead of
+(** Same as {!single_write}, but take the data from a string instead of
a byte sequence.
@since 4.02.0 *)
val in_channel_of_descr : file_descr -> in_channel
(** Create an input channel reading from the given descriptor.
The channel is initially in binary mode; use
- [set_binary_mode_in ic false] if text mode is desired. *)
+ [set_binary_mode_in ic false] if text mode is desired.
+ Text mode is supported only if the descriptor refers to a file
+ or pipe, but is not supported if it refers to a socket.
+
+ On Windows: [set_binary_mode_in] always fails on channels created
+ with this function.
+
+ Beware that channels are buffered so more characters may have been
+ read from the file descriptor than those accessed using channel functions.
+ Channels also keep a copy of the current position in the file.
+
+ You need to explicitly close all channels created with this function.
+ Closing the channel also closes the underlying file descriptor (unless
+ it was already closed). *)
val out_channel_of_descr : file_descr -> out_channel
(** Create an output channel writing on the given descriptor.
The channel is initially in binary mode; use
- [set_binary_mode_out oc false] if text mode is desired. *)
+ [set_binary_mode_out oc false] if text mode is desired.
+ Text mode is supported only if the descriptor refers to a file
+ or pipe, but is not supported if it refers to a socket.
+
+ On Windows: [set_binary_mode_out] always fails on channels created
+ with this function.
+
+ Beware that channels are buffered so you may have to [flush] them
+ to ensure that all data has been sent to the file descriptor.
+ Channels also keep a copy of the current position in the file.
+
+ You need to explicitly close all channels created with this function.
+ Closing the channel flushes the data and closes the underlying file
+ descriptor (unless it has already been closed, in which case the
+ buffered data is lost).*)
val descr_of_in_channel : in_channel -> file_descr
(** Return the descriptor corresponding to an input channel. *)
SEEK_SET (** indicates positions relative to the beginning of the file *)
| SEEK_CUR (** indicates positions relative to the current position *)
| SEEK_END (** indicates positions relative to the end of the file *)
-(** Positioning modes for {!UnixLabels.lseek}. *)
+(** Positioning modes for {!lseek}. *)
val lseek : file_descr -> int -> mode:seek_command -> int
st_mtime : float; (** Last modification time *)
st_ctime : float; (** Last status change time *)
}
-(** The information returned by the {!UnixLabels.stat} calls. *)
+(** The information returned by the {!stat} calls. *)
val stat : string -> stats
(** Return the information for the named file. *)
val lstat : string -> stats
-(** Same as {!UnixLabels.stat}, but in case the file is a symbolic link,
+(** Same as {!stat}, but in case the file is a symbolic link,
return the information for the link itself. *)
val fstat : file_descr -> stats
module LargeFile :
sig
val lseek : file_descr -> int64 -> mode:seek_command -> int64
+ (** See [lseek]. *)
+
val truncate : string -> len:int64 -> unit
+ (** See [truncate]. *)
+
val ftruncate : file_descr -> len:int64 -> unit
+ (** See [ftruncate]. *)
+
type stats = Unix.LargeFile.stats =
{ st_dev : int; (** Device number *)
st_ino : int; (** Inode number *)
end
(** File operations on large files.
This sub-module provides 64-bit variants of the functions
- {!UnixLabels.lseek} (for positioning a file descriptor),
- {!UnixLabels.truncate} and {!UnixLabels.ftruncate}
+ {!lseek} (for positioning a file descriptor),
+ {!truncate} and {!ftruncate}
(for changing the size of a file),
- and {!UnixLabels.stat}, {!UnixLabels.lstat} and {!UnixLabels.fstat}
+ and {!stat}, {!lstat} and {!fstat}
(for obtaining information on files). These alternate functions represent
positions and sizes by 64-bit integers (type [int64]) instead of
regular integers (type [int]), thus allowing operating on files
whose sizes are greater than [max_int]. *)
-
(** {1 Mapping files into memory} *)
val map_file :
- file_descr -> ?pos:int64 -> kind:('a, 'b) Stdlib.Bigarray.kind ->
+ file_descr ->
+ ?pos (* thwart tools/sync_stdlib_docs *):int64 ->
+ kind:('a, 'b) Stdlib.Bigarray.kind ->
layout:'c Stdlib.Bigarray.layout -> shared:bool -> dims:int array ->
('a, 'b, 'c) Stdlib.Bigarray.Genarray.t
(** Memory mapping of a file as a Bigarray.
- [map_file fd kind layout shared dims]
+ [map_file fd ~kind ~layout ~shared ~dims]
returns a Bigarray of kind [kind], layout [layout],
and dimensions as specified in [dims]. The data contained in
this Bigarray are the contents of the file referred to by
the file descriptor [fd] (as opened previously with
- [Unix.openfile], for example). The optional [pos] parameter
+ {!openfile}, for example). The optional [pos] parameter
is the byte offset in the file of the data being mapped;
it defaults to 0 (map from the beginning of the file).
val unlink : string -> unit
-(** Removes the named file *)
-
-val rename : src:string -> dst:string -> unit
-(** [rename old new] changes the name of a file from [old] to [new]. *)
+(** Removes the named file.
-val link : ?follow:bool -> src:string -> dst:string -> unit
-(** [link ?follow source dest] creates a hard link named [dest] to the file
- named [source].
+ If the named file is a directory, raises:
+ {ul
+ {- [EPERM] on POSIX compliant system}
+ {- [EISDIR] on Linux >= 2.1.132}
+ {- [EACCESS] on Windows}}
+*)
- @param follow indicates whether a [source] symlink is followed or a
- hardlink to [source] itself will be created. On {e Unix} systems this is
+val rename : src:string -> dst:string -> unit
+(** [rename ~src ~dst] changes the name of a file from [src] to [dst],
+ moving it between directories if needed. If [dst] already
+ exists, its contents will be replaced with those of [src].
+ Depending on the operating system, the metadata (permissions,
+ owner, etc) of [dst] can either be preserved or be replaced by
+ those of [src]. *)
+
+val link : ?follow (* thwart tools/sync_stdlib_docs *) :bool ->
+ src:string -> dst:string -> unit
+(** [link ?follow ~src ~dst] creates a hard link named [dst] to the file
+ named [src].
+
+ @param follow indicates whether a [src] symlink is followed or a
+ hardlink to [src] itself will be created. On {e Unix} systems this is
done using the [linkat(2)] function. If [?follow] is not provided, then the
[link(2)] function is used whose behaviour is OS-dependent, but more widely
available.
| W_OK (** Write permission *)
| X_OK (** Execution permission *)
| F_OK (** File exists *)
-(** Flags for the {!UnixLabels.access} call. *)
+(** Flags for the {!access} call. *)
val chmod : string -> perm:file_perm -> unit
(** Change the permissions of the named file. *)
val fchmod : file_descr -> perm:file_perm -> unit
-(** Change the permissions of an opened file. *)
+(** Change the permissions of an opened file.
+
+ On Windows: not implemented. *)
val chown : string -> uid:int -> gid:int -> unit
-(** Change the owner uid and owner gid of the named file. *)
+(** Change the owner uid and owner gid of the named file.
+
+ On Windows: not implemented. *)
val fchown : file_descr -> uid:int -> gid:int -> unit
-(** Change the owner uid and owner gid of an opened file. *)
+(** Change the owner uid and owner gid of an opened file.
+
+ On Windows: not implemented. *)
val umask : int -> int
(** Set the process's file mode creation mask, and return the previous
- mask. *)
+ mask.
+
+ On Windows: not implemented. *)
val access : string -> perm:access_permission list -> unit
-(** Check that the process has the given permissions over the named
- file. Raise [Unix_error] otherwise. *)
+(** Check that the process has the given permissions over the named file.
+
+ On Windows: execute permission [X_OK] cannot be tested, just
+ tests for read permission instead.
+
+ @raise Unix_error otherwise.
+ *)
(** {1 Operations on file descriptors} *)
-val dup : ?cloexec:bool -> file_descr -> file_descr
+val dup : ?cloexec: (* thwart tools/sync_stdlib_docs *) bool ->
+ file_descr -> file_descr
(** Return a new file descriptor referencing the same file as
- the given descriptor. *)
+ the given descriptor.
+ See {!set_close_on_exec} for documentation on the [cloexec]
+ optional argument. *)
-val dup2 : ?cloexec:bool -> src:file_descr -> dst:file_descr -> unit
-(** [dup2 fd1 fd2] duplicates [fd1] to [fd2], closing [fd2] if already
- opened. *)
+val dup2 : ?cloexec: (* thwart tools/sync_stdlib_docs *) bool ->
+ src:file_descr -> dst:file_descr -> unit
+(** [dup2 ~src ~dst] duplicates [src] to [dst], closing [dst] if already
+ opened.
+ See {!set_close_on_exec} for documentation on the [cloexec]
+ optional argument. *)
val set_nonblock : file_descr -> unit
(** Set the ``non-blocking'' flag on the given descriptor.
val clear_nonblock : file_descr -> unit
(** Clear the ``non-blocking'' flag on the given descriptor.
- See {!UnixLabels.set_nonblock}.*)
+ See {!set_nonblock}.*)
val set_close_on_exec : file_descr -> unit
(** Set the ``close-on-exec'' flag on the given descriptor.
A descriptor with the close-on-exec flag is automatically
closed when the current process starts another program with
- one of the [exec] functions. *)
+ one of the [exec], [create_process] and [open_process] functions.
+
+ It is often a security hole to leak file descriptors opened on, say,
+ a private file to an external program: the program, then, gets access
+ to the private file and can do bad things with it. Hence, it is
+ highly recommended to set all file descriptors ``close-on-exec'',
+ except in the very few cases where a file descriptor actually needs
+ to be transmitted to another program.
+
+ The best way to set a file descriptor ``close-on-exec'' is to create
+ it in this state. To this end, the [openfile] function has
+ [O_CLOEXEC] and [O_KEEPEXEC] flags to enforce ``close-on-exec'' mode
+ or ``keep-on-exec'' mode, respectively. All other operations in
+ the Unix module that create file descriptors have an optional
+ argument [?cloexec:bool] to indicate whether the file descriptor
+ should be created in ``close-on-exec'' mode (by writing
+ [~cloexec:true]) or in ``keep-on-exec'' mode (by writing
+ [~cloexec:false]). For historical reasons, the default file
+ descriptor creation mode is ``keep-on-exec'', if no [cloexec] optional
+ argument is given. This is not a safe default, hence it is highly
+ recommended to pass explicit [cloexec] arguments to operations that
+ create file descriptors.
+
+ The [cloexec] optional arguments and the [O_KEEPEXEC] flag were introduced
+ in OCaml 4.05. Earlier, the common practice was to create file descriptors
+ in the default, ``keep-on-exec'' mode, then call [set_close_on_exec]
+ on those freshly-created file descriptors. This is not as safe as
+ creating the file descriptor in ``close-on-exec'' mode because, in
+ multithreaded programs, a window of vulnerability exists between the time
+ when the file descriptor is created and the time [set_close_on_exec]
+ completes. If another thread spawns another program during this window,
+ the descriptor will leak, as it is still in the ``keep-on-exec'' mode.
+
+ Regarding the atomicity guarantees given by [~cloexec:true] or by
+ the use of the [O_CLOEXEC] flag: on all platforms it is guaranteed
+ that a concurrently-executing Caml thread cannot leak the descriptor
+ by starting a new process. On Linux, this guarantee extends to
+ concurrently-executing C threads. As of Feb 2017, other operating
+ systems lack the necessary system calls and still expose a window
+ of vulnerability during which a C thread can see the newly-created
+ file descriptor in ``keep-on-exec'' mode.
+ *)
val clear_close_on_exec : file_descr -> unit
(** Clear the ``close-on-exec'' flag on the given descriptor.
- See {!UnixLabels.set_close_on_exec}.*)
+ See {!set_close_on_exec}.*)
(** {1 Directories} *)
val mkdir : string -> perm:file_perm -> unit
-(** Create a directory with the given permissions. *)
+(** Create a directory with the given permissions (see {!umask}). *)
val rmdir : string -> unit
(** Remove an empty directory. *)
(** Return the name of the current working directory. *)
val chroot : string -> unit
-(** Change the process root directory. *)
+(** Change the process root directory.
+
+ On Windows: not implemented. *)
type dir_handle = Unix.dir_handle
(** The type of descriptors over opened directories. *)
(** {1 Pipes and redirections} *)
-val pipe : ?cloexec:bool -> unit -> file_descr * file_descr
+val pipe : ?cloexec: (* thwart tools/sync_stdlib_docs *) bool ->
+ unit -> file_descr * file_descr
(** Create a pipe. The first component of the result is opened
for reading, that's the exit to the pipe. The second component is
- opened for writing, that's the entrance to the pipe. *)
+ opened for writing, that's the entrance to the pipe.
+ See {!set_close_on_exec} for documentation on the [cloexec]
+ optional argument. *)
val mkfifo : string -> perm:file_perm -> unit
-(** Create a named pipe with the given permissions. *)
+(** Create a named pipe with the given permissions (see {!umask}).
+
+ On Windows: not implemented. *)
(** {1 High-level process and redirection management} *)
val create_process :
prog:string -> args:string array -> stdin:file_descr -> stdout:file_descr ->
stderr:file_descr -> int
-(** [create_process prog args new_stdin new_stdout new_stderr]
+(** [create_process ~prog ~args ~stdin ~stdout ~stderr]
forks a new process that executes the program
in file [prog], with arguments [args]. The pid of the new
process is returned immediately; the new process executes
concurrently with the current process.
The standard input and outputs of the new process are connected
- to the descriptors [new_stdin], [new_stdout] and [new_stderr].
- Passing e.g. [stdout] for [new_stdout] prevents the redirection
+ to the descriptors [stdin], [stdout] and [stderr].
+ Passing e.g. [Stdlib.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.
val create_process_env :
prog:string -> args:string array -> env:string array -> stdin:file_descr ->
stdout:file_descr -> stderr:file_descr -> int
-(** [create_process_env prog args env new_stdin new_stdout new_stderr]
- works as {!UnixLabels.create_process}, except that the extra argument
+(** [create_process_env ~prog ~args ~env ~stdin ~stdout ~stderr]
+ works as {!create_process}, except that the extra argument
[env] specifies the environment passed to the program. *)
runs the given command in parallel with the program.
The standard output of the command is redirected to a pipe,
which can be read via the returned input channel.
- The command is interpreted by the shell [/bin/sh] (cf. [system]). *)
+ The command is interpreted by the shell [/bin/sh]
+ (or [cmd.exe] on Windows), cf. {!system}.
+ The {!Filename.quote_command} function can be used to
+ quote the command and its arguments as appropriate for the shell being
+ used. If the command does not need to be run through the shell,
+ {!open_process_args_in} can be used as a more robust and
+ more efficient alternative to {!open_process_in}. *)
val open_process_out : string -> out_channel
-(** Same as {!UnixLabels.open_process_in}, but redirect the standard input of
+(** Same as {!open_process_in}, but redirect the standard input of
the command to a pipe. Data written to the returned output channel
is sent to the standard input of the command.
Warning: writes on output channels are buffered, hence be careful
to call {!Stdlib.flush} at the right times to ensure
- correct synchronization. *)
+ correct synchronization.
+ If the command does not need to be run through the shell,
+ {!open_process_args_out} can be used instead of
+ {!open_process_out}. *)
val open_process : string -> in_channel * out_channel
-(** Same as {!UnixLabels.open_process_out}, but redirects both the standard
- input and standard output of the command to pipes connected to the two
+(** Same as {!open_process_out}, but redirects both the standard input
+ and standard output of the command to pipes connected to the two
returned channels. The input channel is connected to the output
- of the command, and the output channel to the input of the command. *)
+ of the command, and the output channel to the input of the command.
+ If the command does not need to be run through the shell,
+ {!open_process_args} can be used instead of
+ {!open_process}. *)
val open_process_full :
string -> env:string array -> in_channel * out_channel * in_channel
-(** Similar to {!UnixLabels.open_process}, but the second argument specifies
+(** Similar to {!open_process}, but the second argument specifies
the environment passed to the command. The result is a triple
of channels connected respectively to the standard output, standard input,
- and standard error of the command. *)
+ and standard error of the command.
+ If the command does not need to be run through the shell,
+ {!open_process_args_full} can be used instead of
+ {!open_process_full}. *)
val open_process_args_in : string -> string array -> in_channel
(** High-level pipe and process management. The first argument specifies the
@since 4.08.0 *)
val open_process_args_out : string -> string array -> out_channel
-(** Same as {!Unix.open_process_args_in}, but redirect the standard input of the
+(** Same as {!open_process_args_in}, but redirect the standard input of the
command to a pipe. Data written to the returned output channel is sent to
the standard input of the command. Warning: writes on output channels are
buffered, hence be careful to call {!Stdlib.flush} at the right times to
@since 4.08.0 *)
val open_process_args : string -> string array -> in_channel * out_channel
-(** Same as {!Unix.open_process_args_out}, but redirects both the standard input
+(** Same as {!open_process_args_out}, but redirects both the standard input
and standard output of the command to pipes connected to the two returned
channels. The input channel is connected to the output of the command, and
the output channel to the input of the command.
val open_process_args_full :
string -> string array -> string array ->
in_channel * out_channel * in_channel
-(** Similar to {!Unix.open_process_args}, but the third argument specifies the
+(** Similar to {!open_process_args}, but the third argument specifies the
environment passed to the command. The result is a triple of channels
connected respectively to the standard output, standard input, and standard
error of the command.
@since 4.08.0 *)
+val process_in_pid : in_channel -> int
+(** Return the pid of a process opened via {!open_process_in} or
+ {!open_process_args_in}.
+
+ @since 4.08.0 (4.12.0 in UnixLabels) *)
+
+val process_out_pid : out_channel -> int
+(** Return the pid of a process opened via {!open_process_out} or
+ {!open_process_args_out}.
+
+ @since 4.08.0 (4.12.0 in UnixLabels) *)
+
+val process_pid : in_channel * out_channel -> int
+(** Return the pid of a process opened via {!open_process} or
+ {!open_process_args}.
+
+ @since 4.08.0 (4.12.0 in UnixLabels) *)
+
+val process_full_pid : in_channel * out_channel * in_channel -> int
+(** Return the pid of a process opened via {!open_process_full} or
+ {!open_process_args_full}.
+
+ @since 4.08.0 (4.12.0 in UnixLabels) *)
+
val close_process_in : in_channel -> process_status
-(** Close channels opened by {!UnixLabels.open_process_in},
+(** Close channels opened by {!open_process_in},
wait for the associated command to terminate,
and return its termination status. *)
val close_process_out : out_channel -> process_status
-(** Close channels opened by {!UnixLabels.open_process_out},
+(** Close channels opened by {!open_process_out},
wait for the associated command to terminate,
and return its termination status. *)
val close_process : in_channel * out_channel -> process_status
-(** Close channels opened by {!UnixLabels.open_process},
+(** Close channels opened by {!open_process},
wait for the associated command to terminate,
and return its termination status. *)
val close_process_full :
in_channel * out_channel * in_channel -> process_status
-(** Close channels opened by {!UnixLabels.open_process_full},
+(** Close channels opened by {!open_process_full},
wait for the associated command to terminate,
and return its termination status. *)
(** {1 Symbolic links} *)
-val symlink : ?to_dir:bool -> src:string -> dst:string -> unit
-(** [symlink source dest] creates the file [dest] as a symbolic link
- to the file [source]. See {!Unix.symlink} for details of [~to_dir] *)
+val symlink : ?to_dir: (* thwart tools/sync_stdlib_docs *) bool ->
+ src:string -> dst:string -> unit
+(** [symlink ?to_dir ~src ~dst] creates the file [dst] as a symbolic link
+ to the file [src]. On Windows, [~to_dir] indicates if the symbolic link
+ points to a directory or a file; if omitted, [symlink] examines [src]
+ using [stat] and picks appropriately, if [src] does not exist then [false]
+ is assumed (for this reason, it is recommended that the [~to_dir] parameter
+ be specified in new code). On Unix, [~to_dir] is ignored.
+
+ Windows symbolic links are available in Windows Vista onwards. There are some
+ important differences between Windows symlinks and their POSIX counterparts.
+
+ Windows symbolic links come in two flavours: directory and regular, which
+ designate whether the symbolic link points to a directory or a file. The type
+ must be correct - a directory symlink which actually points to a file cannot
+ be selected with chdir and a file symlink which actually points to a
+ directory cannot be read or written (note that Cygwin's emulation layer
+ ignores this distinction).
+
+ When symbolic links are created to existing targets, this distinction doesn't
+ matter and [symlink] will automatically create the correct kind of symbolic
+ link. The distinction matters when a symbolic link is created to a
+ non-existent target.
+
+ The other caveat is that by default symbolic links are a privileged
+ operation. Administrators will always need to be running elevated (or with
+ UAC disabled) and by default normal user accounts need to be granted the
+ SeCreateSymbolicLinkPrivilege via Local Security Policy (secpol.msc) or via
+ Active Directory.
+
+ {!has_symlink} can be used to check that a process is able to create
+ symbolic links. *)
val has_symlink : unit -> bool
(** Returns [true] if the user is able to create symbolic links. On Windows,
@since 4.03.0 *)
val readlink : string -> string
-(** Read the contents of a link. *)
+(** Read the contents of a symbolic link. *)
(** {1 Polling} *)
(** {1 Locking} *)
-
type lock_command = Unix.lock_command =
F_ULOCK (** Unlock a region *)
| F_LOCK (** Lock a region for writing, and block if already locked *)
| F_TEST (** Test a region for other process locks *)
| F_RLOCK (** Lock a region for reading, and block if already locked *)
| F_TRLOCK (** Lock a region for reading, or fail if already locked *)
-(** Commands for {!UnixLabels.lockf}. *)
+(** Commands for {!lockf}. *)
val lockf : file_descr -> mode:lock_command -> len:int -> unit
-(** [lockf fd cmd size] puts a lock on a region of the file opened
+(** [lockf fd ~mode ~len] puts a lock on a region of the file opened
as [fd]. The region starts at the current read/write position for
- [fd] (as set by {!UnixLabels.lseek}), and extends [size] bytes forward if
- [size] is positive, [size] bytes backwards if [size] is negative,
- or to the end of the file if [size] is zero.
+ [fd] (as set by {!lseek}), and extends [len] bytes forward if
+ [len] is positive, [len] bytes backwards if [len] is negative,
+ or to the end of the file if [len] is zero.
A write lock prevents any other
process from acquiring a read or write lock on the region.
A read lock prevents any other
the specified region.
Finally, the [F_TEST] command tests whether a write lock can be
acquired on the specified region, without actually putting a lock.
- It returns immediately if successful, or fails otherwise. *)
+ It returns immediately if successful, or fails otherwise.
+
+ What happens when a process tries to lock a region of a file that is
+ already locked by the same process depends on the OS. On POSIX-compliant
+ systems, the second lock operation succeeds and may "promote" the older
+ lock from read lock to write lock. On Windows, the second lock
+ operation will block or fail. *)
(** {1 Signals}
*)
val kill : pid:int -> signal:int -> unit
-(** [kill pid sig] sends signal number [sig] to the process
- with id [pid]. *)
+(** [kill ~pid ~signal] sends signal number [signal] to the process
+ with id [pid].
+
+ On Windows: only the {!Sys.sigkill} signal is emulated. *)
type sigprocmask_command = Unix.sigprocmask_command =
SIG_SETMASK
| SIG_UNBLOCK
val sigprocmask : mode:sigprocmask_command -> int list -> int list
-(** [sigprocmask cmd sigs] changes the set of blocked signals.
- If [cmd] is [SIG_SETMASK], blocked signals are set to those in
+(** [sigprocmask ~mode sigs] changes the set of blocked signals.
+ If [mode] is [SIG_SETMASK], blocked signals are set to those in
the list [sigs].
- If [cmd] is [SIG_BLOCK], the signals in [sigs] are added to
+ If [mode] is [SIG_BLOCK], the signals in [sigs] are added to
the set of blocked signals.
- If [cmd] is [SIG_UNBLOCK], the signals in [sigs] are removed
+ If [mode] is [SIG_UNBLOCK], the signals in [sigs] are removed
from the set of blocked signals.
- [sigprocmask] returns the set of previously blocked signals. *)
+ [sigprocmask] returns the set of previously blocked signals.
+
+ When the systhreads version of the [Thread] module is loaded, this
+ 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). *)
val sigpending : unit -> int list
-(** Return the set of blocked signals that are currently pending. *)
+(** Return the set of blocked signals that are currently pending.
+
+ On Windows: not implemented (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 return, the blocked signals are reset to their initial value.
+
+ On Windows: not implemented (no inter-process signals on Windows). *)
val pause : unit -> unit
-(** Wait until a non-ignored, non-blocked signal is delivered. *)
+(** Wait until a non-ignored, non-blocked signal is delivered.
+
+ On Windows: not implemented (no inter-process signals on Windows). *)
(** {1 Time functions} *)
in seconds. *)
val gettimeofday : unit -> float
-(** Same as {!UnixLabels.time}, but with resolution better than 1 second. *)
+(** Same as {!time}, but with resolution better than 1 second. *)
val gmtime : float -> tm
-(** Convert a time in seconds, as returned by {!UnixLabels.time}, into a date
- and a time. Assumes UTC (Coordinated Universal Time), also known as GMT. *)
+(** Convert a time in seconds, as returned by {!time}, into a date and
+ a time. Assumes UTC (Coordinated Universal Time), also known as GMT.
+ To perform the inverse conversion, set the TZ environment variable
+ to "UTC", use {!mktime}, and then restore the original value of TZ. *)
val localtime : float -> tm
-(** Convert a time in seconds, as returned by {!UnixLabels.time}, into a date
- and a time. Assumes the local time zone. *)
+(** Convert a time in seconds, as returned by {!time}, into a date and
+ a time. Assumes the local time zone.
+ The function performing the inverse conversion is {!mktime}. *)
val mktime : tm -> float * tm
(** Convert a date and time, specified by the [tm] argument, into
- a time in seconds, as returned by {!UnixLabels.time}. The [tm_isdst],
+ a time in seconds, as returned by {!time}. The [tm_isdst],
[tm_wday] and [tm_yday] fields of [tm] are ignored. Also return a
normalized copy of the given [tm] record, with the [tm_wday],
[tm_yday], and [tm_isdst] fields recomputed from the other fields,
local time zone. *)
val alarm : int -> int
-(** Schedule a [SIGALRM] signal after the given number of seconds. *)
+(** Schedule a [SIGALRM] signal after the given number of seconds.
+
+ On Windows: not implemented. *)
val sleep : int -> unit
(** Stop execution for the given number of seconds. *)
+val sleepf : float -> unit
+(** Stop execution for the given number of seconds. Like [sleep],
+ but fractions of seconds are supported.
+
+ @since 4.03.0 (4.12.0 in UnixLabels) *)
+
val times : unit -> process_times
-(** Return the execution times of the process. *)
+(** Return the execution times of the process.
+
+ On Windows: partially implemented, will not report timings
+ for child processes. *)
val utimes : string -> access:float -> modif:float -> unit
(** Set the last access time (second arg) and last modification time
(third arg) for a file. Times are expressed in seconds from
- 00:00:00 GMT, Jan. 1, 1970. A time of [0.0] is interpreted as the
- current time. *)
+ 00:00:00 GMT, Jan. 1, 1970. If both times are [0.0], the access
+ and last modification times are both set to the current time. *)
type interval_timer = Unix.interval_timer =
ITIMER_REAL
(** The type describing the status of an interval timer *)
val getitimer : interval_timer -> interval_timer_status
-(** Return the current status of the given interval timer. *)
+(** Return the current status of the given interval timer.
+
+ On Windows: not implemented. *)
val setitimer :
interval_timer -> interval_timer_status -> interval_timer_status
its previous status. The [s] argument is interpreted as follows:
[s.it_value], if nonzero, is the time to the next timer expiration;
[s.it_interval], if nonzero, specifies a value to
- be used in reloading it_value when the timer expires.
- Setting [s.it_value] to zero disable the timer.
+ be used in reloading [it_value] when the timer expires.
+ Setting [s.it_value] to zero disables the timer.
Setting [s.it_interval] to zero causes the timer to be disabled
- after its next expiration. *)
+ after its next expiration.
+ On Windows: not implemented. *)
-(** {1 User id, group id} *)
+(** {1 User id, group id} *)
val getuid : unit -> int
-(** Return the user id of the user executing the process. *)
+(** Return the user id of the user executing the process.
+
+ On Windows: always returns [1]. *)
val geteuid : unit -> int
-(** Return the effective user id under which the process runs. *)
+(** Return the effective user id under which the process runs.
+
+ On Windows: always returns [1]. *)
val setuid : int -> unit
-(** Set the real user id and effective user id for the process. *)
+(** Set the real user id and effective user id for the process.
+
+ On Windows: not implemented. *)
val getgid : unit -> int
-(** Return the group id of the user executing the process. *)
+(** Return the group id of the user executing the process.
+
+ On Windows: always returns [1]. *)
val getegid : unit -> int
-(** Return the effective group id under which the process runs. *)
+(** Return the effective group id under which the process runs.
+
+ On Windows: always returns [1]. *)
val setgid : int -> unit
-(** Set the real group id and effective group id for the process. *)
+(** Set the real group id and effective group id for the process.
+
+ On Windows: not implemented. *)
val getgroups : unit -> int array
(** Return the list of groups to which the user executing the process
- belongs. *)
+ belongs.
+
+ On Windows: always returns [[|1|]]. *)
val setgroups : int array -> unit
- (** [setgroups groups] sets the supplementary group IDs for the
- calling process. Appropriate privileges are required. *)
+(** [setgroups groups] sets the supplementary group IDs for the
+ calling process. Appropriate privileges are required.
+
+ On Windows: not implemented. *)
val initgroups : string -> int -> unit
- (** [initgroups user group] initializes the group access list by
- reading the group database /etc/group and using all groups of
- which [user] is a member. The additional group [group] is also
- added to the list. *)
+(** [initgroups user group] initializes the group access list by
+ reading the group database /etc/group and using all groups of
+ which [user] is a member. The additional group [group] is also
+ added to the list.
+
+ On Windows: not implemented. *)
type passwd_entry = Unix.passwd_entry =
{ pw_name : string;
(** Return the login name of the user executing the process. *)
val getpwnam : string -> passwd_entry
-(** Find an entry in [passwd] with the given name, or raise
- [Not_found] if the matching entry is not found. *)
+(** Find an entry in [passwd] with the given name.
+ @raise Not_found if no such entry exists, or always on Windows. *)
val getgrnam : string -> group_entry
-(** Find an entry in [group] with the given name, or raise
- [Not_found] if the matching entry is not found. *)
+(** Find an entry in [group] with the given name.
+
+ @raise Not_found if no such entry exists, or always on Windows. *)
val getpwuid : int -> passwd_entry
-(** Find an entry in [passwd] with the given user id, or raise
- [Not_found] if the matching entry is not found. *)
+(** Find an entry in [passwd] with the given user id.
+
+ @raise Not_found if no such entry exists, or always on Windows. *)
val getgrgid : int -> group_entry
-(** Find an entry in [group] with the given group id, or raise
- [Not_found] if the matching entry is not found. *)
+(** Find an entry in [group] with the given group id.
+
+ @raise Not_found if no such entry exists, or always on Windows. *)
(** {1 Internet addresses} *)
address to its internal representation. The argument string
consists of 4 numbers separated by periods ([XXX.YYY.ZZZ.TTT])
for IPv4 addresses, and up to 8 numbers separated by colons
- for IPv6 addresses. Raise [Failure] when given a string that
- does not match these formats. *)
+ for IPv6 addresses.
+ @raise Failure when given a string that does not match these formats. *)
val string_of_inet_addr : inet_addr -> string
(** Return the printable representation of the given Internet address.
- See {!Unix.inet_addr_of_string} for a description of the
+ See {!inet_addr_of_string} for a description of the
printable representation. *)
val inet_addr_any : inet_addr
val inet6_addr_loopback : inet_addr
(** A special IPv6 address representing the host machine ([::1]). *)
+val is_inet6_addr : inet_addr -> bool
+(** Whether the given [inet_addr] is an IPv6 address.
+ @since 4.12.0 *)
(** {1 Sockets} *)
| PF_INET (** Internet domain (IPv4) *)
| PF_INET6 (** Internet domain (IPv6) *)
(** The type of socket domains. Not all platforms support
- IPv6 sockets (type [PF_INET6]). *)
+ IPv6 sockets (type [PF_INET6]).
+
+ On Windows: [PF_UNIX] not implemented. *)
type socket_type = Unix.socket_type =
SOCK_STREAM (** Stream socket *)
| SOCK_RAW (** Raw socket *)
| SOCK_SEQPACKET (** Sequenced packets socket *)
(** The type of socket kinds, specifying the semantics of
- communications. *)
+ communications. [SOCK_SEQPACKET] is included for completeness,
+ but is rarely supported by the OS, and needs system calls that
+ are not available in this library. *)
type sockaddr = Unix.sockaddr =
ADDR_UNIX of string
[port] is the port number. *)
val socket :
- ?cloexec:bool -> domain:socket_domain -> kind:socket_type -> protocol:int ->
- file_descr
+ ?cloexec: (* thwart tools/sync_stdlib_docs *) bool ->
+ domain:socket_domain -> kind:socket_type -> protocol:int -> file_descr
(** Create a new socket in the given domain, and with the
given kind. The third argument is the protocol type; 0 selects
- the default protocol for that kind of sockets. *)
+ the default protocol for that kind of sockets.
+ See {!set_close_on_exec} for documentation on the [cloexec]
+ optional argument. *)
val domain_of_sockaddr: sockaddr -> socket_domain
(** Return the socket domain adequate for the given socket address. *)
val socketpair :
- ?cloexec:bool -> domain:socket_domain -> kind:socket_type -> protocol:int ->
+ ?cloexec: (* thwart tools/sync_stdlib_docs *) bool ->
+ domain:socket_domain -> kind:socket_type -> protocol:int ->
file_descr * file_descr
-(** Create a pair of unnamed sockets, connected together. *)
+(** Create a pair of unnamed sockets, connected together.
+ See {!set_close_on_exec} for documentation on the [cloexec]
+ optional argument. *)
-val accept : ?cloexec:bool -> file_descr -> file_descr * sockaddr
+val accept : ?cloexec: (* thwart tools/sync_stdlib_docs *) bool ->
+ file_descr -> file_descr * sockaddr
(** Accept connections on the given socket. The returned descriptor
is a socket connected to the client; the returned address is
- the address of the connecting client. *)
+ the address of the connecting client.
+ See {!set_close_on_exec} for documentation on the [cloexec]
+ optional argument. *)
val bind : file_descr -> addr:sockaddr -> unit
(** Bind a socket to an address. *)
MSG_OOB
| MSG_DONTROUTE
| MSG_PEEK (**)
-(** The flags for {!UnixLabels.recv}, {!UnixLabels.recvfrom},
- {!UnixLabels.send} and {!UnixLabels.sendto}. *)
+(** The flags for {!recv}, {!recvfrom}, {!send} and {!sendto}. *)
val recv :
file_descr -> buf:bytes -> pos:int -> len:int -> mode:msg_flag list -> int
(** {1 Socket options} *)
-type socket_bool_option =
+type socket_bool_option = Unix.socket_bool_option =
SO_DEBUG (** Record debugging information *)
| SO_BROADCAST (** Permit sending of broadcast messages *)
| SO_REUSEADDR (** Allow reuse of local addresses for bind *)
| SO_ACCEPTCONN (** Report whether socket listening is enabled *)
| TCP_NODELAY (** Control the Nagle algorithm for TCP sockets *)
| IPV6_ONLY (** Forbid binding an IPv6 socket to an IPv4 address *)
-(** The socket options that can be consulted with {!UnixLabels.getsockopt}
- and modified with {!UnixLabels.setsockopt}. These options have a boolean
+ | SO_REUSEPORT (** Allow reuse of address and port bindings *)
+(** The socket options that can be consulted with {!getsockopt}
+ and modified with {!setsockopt}. These options have a boolean
([true]/[false]) value. *)
-type socket_int_option =
+type socket_int_option = Unix.socket_int_option =
SO_SNDBUF (** Size of send buffer *)
| SO_RCVBUF (** Size of received buffer *)
- | SO_ERROR (** Deprecated. Use {!Unix.getsockopt_error} instead. *)
+ | SO_ERROR (** Deprecated. Use {!getsockopt_error} instead. *)
| SO_TYPE (** Report the socket type *)
| SO_RCVLOWAT (** Minimum number of bytes to process for input operations *)
| SO_SNDLOWAT (** Minimum number of bytes to process for output operations *)
-(** The socket options that can be consulted with {!UnixLabels.getsockopt_int}
- and modified with {!UnixLabels.setsockopt_int}. These options have an
+(** The socket options that can be consulted with {!getsockopt_int}
+ and modified with {!setsockopt_int}. These options have an
integer value. *)
-type socket_optint_option =
+type socket_optint_option = Unix.socket_optint_option =
SO_LINGER (** Whether to linger on closed connections
that have data present, and for how long
(in seconds) *)
-(** The socket options that can be consulted with {!Unix.getsockopt_optint}
- and modified with {!Unix.setsockopt_optint}. These options have a
+(** The socket options that can be consulted with {!getsockopt_optint}
+ and modified with {!setsockopt_optint}. These options have a
value of type [int option], with [None] meaning ``disabled''. *)
-type socket_float_option =
+type socket_float_option = Unix.socket_float_option =
SO_RCVTIMEO (** Timeout for input operations *)
| SO_SNDTIMEO (** Timeout for output operations *)
-(** The socket options that can be consulted with {!UnixLabels.getsockopt_float}
- and modified with {!UnixLabels.setsockopt_float}. These options have a
+(** The socket options that can be consulted with {!getsockopt_float}
+ and modified with {!setsockopt_float}. These options have a
floating-point value representing a time in seconds.
The value 0 means infinite timeout. *)
(** Set or clear a boolean-valued option in the given socket. *)
val getsockopt_int : file_descr -> socket_int_option -> int
-(** Same as {!Unix.getsockopt} for an integer-valued socket option. *)
+(** Same as {!getsockopt} for an integer-valued socket option. *)
val setsockopt_int : file_descr -> socket_int_option -> int -> unit
-(** Same as {!Unix.setsockopt} for an integer-valued socket option. *)
+(** Same as {!setsockopt} for an integer-valued socket option. *)
val getsockopt_optint : file_descr -> socket_optint_option -> int option
-(** Same as {!Unix.getsockopt} for a socket option whose value is
+(** Same as {!getsockopt} for a socket option whose value is
an [int option]. *)
val setsockopt_optint :
file_descr -> socket_optint_option -> int option -> unit
-(** Same as {!Unix.setsockopt} for a socket option whose value is
+(** Same as {!setsockopt} for a socket option whose value is
an [int option]. *)
val getsockopt_float : file_descr -> socket_float_option -> float
-(** Same as {!Unix.getsockopt} for a socket option whose value is a
+(** Same as {!getsockopt} for a socket option whose value is a
floating-point number. *)
val setsockopt_float : file_descr -> socket_float_option -> float -> unit
-(** Same as {!Unix.setsockopt} for a socket option whose value is a
+(** Same as {!setsockopt} for a socket option whose value is a
floating-point number. *)
val getsockopt_error : file_descr -> error option
times to ensure correct synchronization. *)
val shutdown_connection : in_channel -> unit
-(** ``Shut down'' a connection established with {!UnixLabels.open_connection};
+(** ``Shut down'' a connection established with {!open_connection};
that is, transmit an end-of-file condition to the server reading
- on the other side of the connection. *)
+ on the other side of the connection. This does not fully close the
+ file descriptor associated with the channel, which you must remember
+ to free via {!Stdlib.close_in}. *)
val establish_server :
(in_channel -> out_channel -> unit) -> addr:sockaddr -> unit
(** Establish a server on the given address.
The function given as first argument is called for each connection
with two buffered channels connected to the client. A new process
- is created for each connection. The function {!UnixLabels.establish_server}
- never returns normally. *)
+ is created for each connection. The function {!establish_server}
+ never returns normally.
+ On Windows: not implemented (use threads). *)
-(** {1 Host and protocol databases} *)
+(** {1 Host and protocol databases} *)
type host_entry = Unix.host_entry =
{ h_name : string;
(** Return the name of the local host. *)
val gethostbyname : string -> host_entry
-(** Find an entry in [hosts] with the given name, or raise
- [Not_found]. *)
+(** Find an entry in [hosts] with the given name.
+ @raise Not_found if no such entry exists. *)
val gethostbyaddr : inet_addr -> host_entry
-(** Find an entry in [hosts] with the given address, or raise
- [Not_found]. *)
+(** Find an entry in [hosts] with the given address.
+ @raise Not_found if no such entry exists. *)
val getprotobyname : string -> protocol_entry
-(** Find an entry in [protocols] with the given name, or raise
- [Not_found]. *)
+(** Find an entry in [protocols] with the given name.
+ @raise Not_found if no such entry exists. *)
val getprotobynumber : int -> protocol_entry
-(** Find an entry in [protocols] with the given protocol number,
- or raise [Not_found]. *)
+(** Find an entry in [protocols] with the given protocol number.
+ @raise Not_found if no such entry exists. *)
val getservbyname : string -> protocol:string -> service_entry
-(** Find an entry in [services] with the given name, or raise
- [Not_found]. *)
+(** Find an entry in [services] with the given name.
+ @raise Not_found if no such entry exists. *)
val getservbyport : int -> protocol:string -> service_entry
-(** Find an entry in [services] with the given service number,
- or raise [Not_found]. *)
+(** Find an entry in [services] with the given service number.
+ @raise Not_found if no such entry exists. *)
-type addr_info =
+type addr_info = Unix.addr_info =
{ ai_family : socket_domain; (** Socket domain *)
ai_socktype : socket_type; (** Socket type *)
ai_protocol : int; (** Socket protocol number *)
ai_addr : sockaddr; (** Address *)
ai_canonname : string (** Canonical host name *)
}
-(** Address information returned by {!Unix.getaddrinfo}. *)
+(** Address information returned by {!getaddrinfo}. *)
-type getaddrinfo_option =
+type getaddrinfo_option = Unix.getaddrinfo_option =
AI_FAMILY of socket_domain (** Impose the given socket domain *)
| AI_SOCKTYPE of socket_type (** Impose the given socket type *)
| AI_PROTOCOL of int (** Impose the given protocol *)
| AI_CANONNAME (** Fill the [ai_canonname] field
of the result *)
| AI_PASSIVE (** Set address to ``any'' address
- for use with {!Unix.bind} *)
-(** Options to {!Unix.getaddrinfo}. *)
+ for use with {!bind} *)
+(** Options to {!getaddrinfo}. *)
val getaddrinfo:
string -> string -> getaddrinfo_option list -> addr_info list
-(** [getaddrinfo host service opts] returns a list of {!Unix.addr_info}
+(** [getaddrinfo host service opts] returns a list of {!addr_info}
records describing socket parameters and addresses suitable for
communicating with the given host and service. The empty list is
returned if the host or service names are unknown, or the constraints
to force a particular socket domain (e.g. IPv6 only or IPv4 only)
or a particular socket type (e.g. TCP only or UDP only). *)
-type name_info =
+type name_info = Unix.name_info =
{ ni_hostname : string; (** Name or IP address of host *)
ni_service : string; (** Name of service or port number *)
}
-(** Host and service information returned by {!Unix.getnameinfo}. *)
+(** Host and service information returned by {!getnameinfo}. *)
-type getnameinfo_option =
+type getnameinfo_option = Unix.getnameinfo_option =
NI_NOFQDN (** Do not qualify local host names *)
| NI_NUMERICHOST (** Always return host as IP address *)
| NI_NAMEREQD (** Fail if host name cannot be determined *)
| NI_NUMERICSERV (** Always return service as port number *)
| NI_DGRAM (** Consider the service as UDP-based
instead of the default TCP *)
-(** Options to {!Unix.getnameinfo}. *)
+(** Options to {!getnameinfo}. *)
val getnameinfo : sockaddr -> getnameinfo_option list -> name_info
(** [getnameinfo addr opts] returns the host name and service name
corresponding to the socket address [addr]. [opts] is a possibly
empty list of options that governs how these names are obtained.
- Raise [Not_found] if an error occurs. *)
+ @raise Not_found if an error occurs. *)
(** {1 Terminal interface} *)
val tcgetattr : file_descr -> terminal_io
(** Return the status of the terminal referred to by the given
- file descriptor. *)
+ file descriptor.
+
+ On Windows: not implemented. *)
type setattr_when = Unix.setattr_when =
TCSANOW
or after flushing all input that has been received but not
read ([TCSAFLUSH]). [TCSADRAIN] is recommended when changing
the output parameters; [TCSAFLUSH], when changing the input
- parameters. *)
+ parameters.
+
+ On Windows: not implemented. *)
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). *)
+ 0 means standard duration (0.25s).
+
+ On Windows: not implemented. *)
val tcdrain : file_descr -> unit
(** Waits until all output written on the given file descriptor
- has been transmitted. *)
+ has been transmitted.
+
+ On Windows: not implemented. *)
type flush_queue = Unix.flush_queue =
TCIFLUSH
transmitted, or data received but not yet read, depending on the
second argument: [TCIFLUSH] flushes data received but not read,
[TCOFLUSH] flushes data written but not transmitted, and
- [TCIOFLUSH] flushes both. *)
+ [TCIOFLUSH] flushes both.
+
+ On Windows: not implemented. *)
type flow_action = Unix.flow_action =
TCOOFF
the given file descriptor, depending on the second argument:
[TCOOFF] suspends output, [TCOON] restarts output,
[TCIOFF] transmits a STOP character to suspend input,
- and [TCION] transmits a START character to restart input. *)
+ and [TCION] transmits a START character to restart input.
+
+ On Windows: not implemented. *)
val setsid : unit -> int
(** Put the calling process in a new session and detach it from
- its controlling terminal. *)
+ its controlling terminal.
+
+ On Windows: not implemented. *)
-accept.$(O): accept.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/domain.h \
- ../../runtime/caml/signals.h unixsupport.h socketaddr.h \
- ../../runtime/caml/misc.h
-bind.$(O): bind.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
- ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl unixsupport.h socketaddr.h \
- ../../runtime/caml/misc.h
-channels.$(O): channels.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/io.h ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
- ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
- unixsupport.h
-close.$(O): close.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl unixsupport.h \
- ../../runtime/caml/io.h
-close_on.$(O): close_on.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl unixsupport.h
-connect.$(O): connect.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/signals.h \
- unixsupport.h socketaddr.h ../../runtime/caml/misc.h
-createprocess.$(O): createprocess.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
- ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
- unixsupport.h ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h
-dup.$(O): dup.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
- ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl unixsupport.h
-dup2.$(O): dup2.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
- ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl unixsupport.h
-errmsg.$(O): errmsg.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
- ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
- unixsupport.h
-envir.$(O): envir.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
- ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
- ../../runtime/caml/domain.h ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h
-getpeername.$(O): getpeername.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl unixsupport.h socketaddr.h \
- ../../runtime/caml/misc.h
-getpid.$(O): getpid.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl unixsupport.h
-getsockname.$(O): getsockname.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl unixsupport.h socketaddr.h \
- ../../runtime/caml/misc.h
-gettimeofday.$(O): gettimeofday.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- unixsupport.h
-isatty.$(O): isatty.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
- ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
- ../../runtime/caml/domain.h unixsupport.h
-link.$(O): link.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
- ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/fail.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
- ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
- ../../runtime/caml/domain.h ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h unixsupport.h
-listen.$(O): listen.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl unixsupport.h
-lockf.$(O): lockf.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h ../../runtime/caml/fail.h unixsupport.h \
- ../../runtime/caml/signals.h
-lseek.$(O): lseek.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- unixsupport.h
-nonblock.$(O): nonblock.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/signals.h \
- unixsupport.h
-mkdir.$(O): mkdir.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
- ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
- ../../runtime/caml/domain.h ../../runtime/caml/memory.h unixsupport.h
-mmap.$(O): mmap.c ../../runtime/caml/alloc.h ../../runtime/caml/misc.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
- ../../runtime/caml/bigarray.h ../../runtime/caml/fail.h \
- ../../runtime/caml/io.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/signals.h ../../runtime/caml/sys.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
- ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
- unixsupport.h
-open.$(O): open.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
- ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
- ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
- ../../runtime/caml/memory.h unixsupport.h
-pipe.$(O): pipe.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
- ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h ../../runtime/caml/alloc.h unixsupport.h
-read.$(O): read.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
- ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
-readlink.$(O): readlink.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
- ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/fail.h \
- ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h unixsupport.h
-rename.$(O): rename.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
- ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
- ../../runtime/caml/domain.h ../../runtime/caml/memory.h unixsupport.h
-select.$(O): select.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/domain.h \
- ../../runtime/caml/fail.h ../../runtime/caml/signals.h winworker.h \
- unixsupport.h windbug.h winlist.h
-sendrecv.$(O): sendrecv.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/domain.h \
- ../../runtime/caml/signals.h unixsupport.h socketaddr.h \
- ../../runtime/caml/misc.h
-shutdown.$(O): shutdown.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl unixsupport.h
-sleep.$(O): sleep.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/signals.h \
- unixsupport.h
-socket.$(O): socket.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl unixsupport.h
-sockopt.$(O): sockopt.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h unixsupport.h socketaddr.h \
- ../../runtime/caml/misc.h
-startup.$(O): startup.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl winworker.h unixsupport.h windbug.h
-stat.$(O): stat.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
- ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
- ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/signals.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h \
- ../unix/cst2constr.h
-symlink.$(O): symlink.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
- ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/fail.h \
- ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h unixsupport.h
-system.$(O): system.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
- ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/signals.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
-times.$(O): times.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- unixsupport.h
-truncate.$(O): truncate.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
- ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
- ../../runtime/caml/fail.h ../../runtime/caml/signals.h \
- ../../runtime/caml/io.h ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h unixsupport.h
-unixsupport.$(O): unixsupport.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/callback.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h ../../runtime/caml/fail.h \
- ../../runtime/caml/custom.h unixsupport.h ../unix/cst2constr.h
-windir.$(O): windir.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
- ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
- ../../runtime/caml/alloc.h ../../runtime/caml/fail.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
-winwait.$(O): winwait.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/domain.h \
- ../../runtime/caml/signals.h unixsupport.h
-write.$(O): write.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h
-winlist.$(O): winlist.c winlist.h
-winworker.$(O): winworker.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/domain.h \
- ../../runtime/caml/signals.h winworker.h unixsupport.h winlist.h \
- windbug.h
-windbug.$(O): windbug.c windbug.h
-utimes.$(O): utimes.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
- ../../runtime/caml/mlvalues.h ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
- ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
- ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h unixsupport.h
-access.$(O): access.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/domain.h \
- ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h unixsupport.h
-addrofstr.$(O): addrofstr.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h ../../runtime/caml/fail.h unixsupport.h \
- socketaddr.h ../../runtime/caml/misc.h
-chdir.$(O): chdir.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
- ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
- ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h unixsupport.h
-chmod.$(O): chmod.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
- ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
- ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h unixsupport.h
-cst2constr.$(O): cst2constr.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/fail.h \
- ../unix/cst2constr.h
-cstringv.$(O): cstringv.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
- ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
-execv.$(O): execv.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
- ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
-execve.$(O): execve.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
- ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
-execvp.$(O): execvp.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h unixsupport.h
-exit.$(O): exit.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
- ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl unixsupport.h
-getaddrinfo.$(O): getaddrinfo.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h ../../runtime/caml/misc.h \
- ../../runtime/caml/signals.h unixsupport.h ../unix/cst2constr.h \
- socketaddr.h
-getcwd.$(O): getcwd.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
- ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
- ../../runtime/caml/domain.h unixsupport.h
-gethost.$(O): gethost.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h \
- socketaddr.h ../../runtime/caml/misc.h
-gethostname.$(O): gethostname.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h unixsupport.h
-getnameinfo.$(O): getnameinfo.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h \
- socketaddr.h ../../runtime/caml/misc.h
-getproto.$(O): getproto.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h unixsupport.h
-getserv.$(O): getserv.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h unixsupport.h
-gmtime.$(O): gmtime.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h ../../runtime/caml/memory.h \
- ../../runtime/caml/domain.h unixsupport.h
-mmap_ba.$(O): mmap_ba.c ../../runtime/caml/alloc.h ../../runtime/caml/misc.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
- ../../runtime/caml/bigarray.h ../../runtime/caml/custom.h \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
- ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
- ../../runtime/caml/domain.h ../../runtime/caml/misc.h
-putenv.$(O): putenv.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \
- ../../runtime/caml/memory.h ../../runtime/caml/gc.h \
- ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \
- ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \
- ../../runtime/caml/domain.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h
-rmdir.$(O): rmdir.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
- ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
- ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h unixsupport.h
-socketaddr.$(O): socketaddr.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/memory.h ../../runtime/caml/domain.h unixsupport.h \
- socketaddr.h ../../runtime/caml/misc.h
-strofaddr.$(O): strofaddr.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- ../../runtime/caml/fail.h unixsupport.h socketaddr.h \
- ../../runtime/caml/misc.h
-time.$(O): time.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \
- ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \
- unixsupport.h
-unlink.$(O): unlink.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \
- ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \
- ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \
- ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \
- ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \
- ../../runtime/caml/memory.h unixsupport.h
-fsync.$(O): fsync.c ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/config.h ../../runtime/caml/m.h \
- ../../runtime/caml/s.h ../../runtime/caml/misc.h \
- ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \
- ../../runtime/caml/domain_state.tbl ../../runtime/caml/signals.h \
- unixsupport.h
unix.cmo : \
unix.cmi
unix.cmx : \
close_on.c connect.c createprocess.c dup.c dup2.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 \
- mkdir.c mmap.c open.c pipe.c read.c readlink.c rename.c \
+ mmap.c open.c pipe.c read.c readlink.c rename.c \
select.c sendrecv.c \
shutdown.c sleep.c socket.c sockopt.c startup.c stat.c \
symlink.c system.c times.c truncate.c unixsupport.c windir.c winwait.c \
# Files from the ../unix directory
UNIX_FILES = access.c addrofstr.c chdir.c chmod.c cst2constr.c \
- cstringv.c execv.c execve.c execvp.c \
+ cstringv.c execv.c execve.c execvp.c mkdir.c \
exit.c getaddrinfo.c getcwd.c gethost.c gethostname.c \
getnameinfo.c getproto.c \
getserv.c gmtime.c mmap_ba.c putenv.c rmdir.c \
WIN32_LIBS=$(call SYSLIB,ws2_32) $(call SYSLIB,advapi32)
LINKOPTS=$(addprefix -cclib ,$(WIN32_LIBS))
EXTRACAMLFLAGS=-nolabels
-EXTRACFLAGS=-I../unix
-HEADERS=unixsupport.h socketaddr.h
+EXTRACPPFLAGS=-I../unix
+HEADERS=unixsupport.h ../unix/socketaddr.h
+unixLabels.cmi: \
+ EXTRACAMLFLAGS += -pp "$(AWK) -f $(ROOTDIR)/stdlib/expand_module_aliases.awk"
include ../Makefile.otherlibs.common
-ifeq "$(SYSTEM)" "mingw"
-LDOPTS=-ldopt "-link -static-libgcc" $(addprefix -ldopt ,$(WIN32_LIBS))
-else
LDOPTS=$(addprefix -ldopt ,$(WIN32_LIBS))
-endif
clean::
rm -f $(UNIX_FILES) $(UNIX_CAML_FILES)
cp ../unix/$* $*
.PHONY: depend
-ifeq "$(TOOLCHAIN)" "msvc"
-depend:
- $(error Dependencies cannot be regenerated using the MSVC ports)
-else
depend: $(ALL_FILES) $(UNIX_CAML_FILES) unix.ml
- $(CC) -MM $(OC_CPPFLAGS) -I../unix $(ALL_FILES) \
- | sed -e 's/\.o/.$$(O)/g' > .depend
$(CAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash $(UNIX_CAML_FILES) \
- unix.ml >> .depend
-endif
+ unix.ml > .depend
include .depend
socklen_param_type addr_len;
DWORD err = 0;
- addr_len = sizeof(sock_addr);
+ addr_len = sizeof(addr);
caml_enter_blocking_section();
snew = accept(sconn, &addr.s_gen, &addr_len);
if (snew == INVALID_SOCKET) err = WSAGetLastError ();
#include "unixsupport.h"
#include "socketaddr.h"
-CAMLprim value unix_getpeername(sock)
- value sock;
+CAMLprim value unix_getpeername(value sock)
{
int retcode;
union sock_addr_union addr;
socklen_param_type addr_len;
- addr_len = sizeof(sock_addr);
- retcode = getpeername(Socket_val(sock),
- &addr.s_gen, &addr_len);
+ addr_len = sizeof(addr);
+ retcode = getpeername(Socket_val(sock), &addr.s_gen, &addr_len);
if (retcode == -1) {
win32_maperr(WSAGetLastError());
uerror("getpeername", Nothing);
#include "unixsupport.h"
#include "socketaddr.h"
-CAMLprim value unix_getsockname(sock)
- value sock;
+CAMLprim value unix_getsockname(value sock)
{
int retcode;
union sock_addr_union addr;
socklen_param_type addr_len;
- addr_len = sizeof(sock_addr);
- retcode = getsockname(Socket_val(sock),
- &addr.s_gen, &addr_len);
+ addr_len = sizeof(addr);
+ retcode = getsockname(Socket_val(sock), &addr.s_gen, &addr_len);
if (retcode == -1) uerror("getsockname", Nothing);
return alloc_sockaddr(&addr, addr_len, -1);
}
/* Unix epoch as a Windows timestamp in hundreds of ns */
#define epoch_ft 116444736000000000.0;
-CAMLprim value unix_gettimeofday(value unit)
+double unix_gettimeofday_unboxed(value unit)
{
FILETIME ft;
double tm;
#else
tm = *(uint64_t *)&ft - epoch_ft; /* shift to Epoch-relative time */
#endif
- return caml_copy_double(tm * 1e-7); /* tm is in 100ns */
+ return (tm * 1e-7); /* tm is in 100ns */
+}
+
+CAMLprim value unix_gettimeofday(value unit)
+{
+ return caml_copy_double(unix_gettimeofday_unboxed(unit));
}
+++ /dev/null
-/**************************************************************************/
-/* */
-/* OCaml */
-/* */
-/* Xavier Leroy and Pascal Cuoq, 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. */
-/* */
-/**************************************************************************/
-
-#define CAML_INTERNALS
-
-#include <caml/mlvalues.h>
-#include <caml/osdeps.h>
-#include <caml/memory.h>
-#include "unixsupport.h"
-
-CAMLprim value unix_mkdir(path, perm)
- value path, perm;
-{
- int err;
- wchar_t * wpath;
- caml_unix_check_path(path, "mkdir");
- wpath = caml_stat_strdup_to_utf16(String_val(path));
- err = _wmkdir(wpath);
- caml_stat_free(wpath);
- if (err == -1) uerror("mkdir", path);
- return Val_unit;
-}
do { win32_maperr(GetLastError()); uerror(func, arg); } while(0)
/* Defined in [mmap_ba.c] */
-CAMLextern value
-caml_unix_mapped_alloc(int flags, int num_dims, void * data, intnat * dim);
+extern value caml_unix_mapped_alloc(int, int, void *, intnat *);
#ifndef INVALID_SET_FILE_POINTER
#define INVALID_SET_FILE_POINTER (-1)
Begin_roots2 (buff, adr);
numbytes = Long_val(len);
if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE;
- addr_len = sizeof(sock_addr);
+ addr_len = sizeof(addr);
caml_enter_blocking_section();
ret = recvfrom(s, iobuf, (int) numbytes, flg, &addr.s_gen, &addr_len);
if (ret == -1) err = WSAGetLastError();
+++ /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. */
-/* */
-/**************************************************************************/
-
-#ifndef CAML_SOCKETADDR_H
-#define CAML_SOCKETADDR_H
-
-#include "caml/misc.h"
-
-union sock_addr_union {
- struct sockaddr s_gen;
- struct sockaddr_in s_inet;
-#ifdef HAS_IPV6
- struct sockaddr_in6 s_inet6;
-#endif
-};
-
-extern union sock_addr_union sock_addr;
-
-#ifdef HAS_SOCKLEN_T
-typedef socklen_t socklen_param_type;
-#else
-typedef int socklen_param_type;
-#endif
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-extern void get_sockaddr (value mladdr,
- union sock_addr_union * addr /*out*/,
- socklen_param_type * addr_len /*out*/);
-CAMLprim value alloc_sockaddr (union sock_addr_union * addr /*in*/,
- socklen_param_type addr_len, int close_on_error);
-CAMLprim value alloc_inet_addr (struct in_addr * inaddr);
-#define GET_INET_ADDR(v) (*((struct in_addr *) (v)))
-
-#ifdef HAS_IPV6
-CAMLexport value alloc_inet6_addr (struct in6_addr * inaddr);
-#define GET_INET6_ADDR(v) (*((struct in6_addr *) (v)))
-#endif
-
-#ifdef __cplusplus
-}
-#endif
-
-#endif /* CAML_SOCKETADDR_H */
#include "unixsupport.h"
#include "socketaddr.h"
+#ifndef SO_REUSEPORT
+#define SO_REUSEPORT (-1)
+#endif
#ifndef IPPROTO_IPV6
#define IPPROTO_IPV6 (-1)
#endif
{ SOL_SOCKET, SO_OOBINLINE },
{ SOL_SOCKET, SO_ACCEPTCONN },
{ IPPROTO_TCP, TCP_NODELAY },
- { IPPROTO_IPV6, IPV6_V6ONLY}
+ { IPPROTO_IPV6, IPV6_V6ONLY},
+ { SOL_SOCKET, SO_REUSEPORT }
};
static struct socket_option sockopt_int[] = {
#include <caml/osdeps.h>
#include "unixsupport.h"
#include "cst2constr.h"
-#define _INTEGRAL_MAX_BITS 64
#include <sys/types.h>
#include <sys/stat.h>
#include <time.h>
#include <caml/osdeps.h>
#include "unixsupport.h"
+#ifndef SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE
+#define SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE (0x2)
+#endif
+
typedef BOOLEAN (WINAPI *LPFN_CREATESYMBOLICLINK) (LPWSTR, LPWSTR, DWORD);
static LPFN_CREATESYMBOLICLINK pCreateSymbolicLink = NULL;
static int no_symlink = 0;
+static DWORD additional_symlink_flags = 0;
+
+// Developer Mode allows the creation of symlinks without elevation - see
+// https://docs.microsoft.com/en-us/windows/win32/api/winbase/nf-winbase-createsymboliclinkw
+static BOOL IsDeveloperModeEnabled()
+{
+ HKEY hKey;
+ LSTATUS status;
+ DWORD developerModeRegistryValue, dwordSize = sizeof(DWORD);
+
+ status = RegOpenKeyExW(
+ HKEY_LOCAL_MACHINE,
+ L"SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\AppModelUnlock",
+ 0,
+ KEY_READ | KEY_WOW64_64KEY,
+ &hKey
+ );
+ if (status != ERROR_SUCCESS) {
+ return FALSE;
+ }
+
+ status = RegQueryValueExW(
+ hKey,
+ L"AllowDevelopmentWithoutDevLicense",
+ NULL,
+ NULL,
+ (LPBYTE)&developerModeRegistryValue,
+ &dwordSize
+ );
+ RegCloseKey(hKey);
+ if (status != ERROR_SUCCESS) {
+ return FALSE;
+ }
+ return developerModeRegistryValue != 0;
+}
CAMLprim value unix_symlink(value to_dir, value osource, value odest)
{
CAMLparam3(to_dir, osource, odest);
- DWORD flags = (Bool_val(to_dir) ? SYMBOLIC_LINK_FLAG_DIRECTORY : 0);
+ DWORD flags;
BOOLEAN result;
LPWSTR source;
LPWSTR dest;
}
if (!pCreateSymbolicLink) {
- pCreateSymbolicLink = (LPFN_CREATESYMBOLICLINK)GetProcAddress(GetModuleHandle(L"kernel32"), "CreateSymbolicLinkW");
- no_symlink = !pCreateSymbolicLink;
+ if (!(pCreateSymbolicLink = (LPFN_CREATESYMBOLICLINK)GetProcAddress(GetModuleHandle(L"kernel32"), "CreateSymbolicLinkW"))) {
+ no_symlink = 1;
+ } else if (IsDeveloperModeEnabled()) {
+ additional_symlink_flags = SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE;
+ }
+
goto again;
}
+ flags = (Bool_val(to_dir) ? SYMBOLIC_LINK_FLAG_DIRECTORY : 0) | additional_symlink_flags;
+
/* Copy source and dest outside the OCaml heap */
source = caml_stat_strdup_to_utf16(String_val(osource));
dest = caml_stat_strdup_to_utf16(String_val(odest));
HANDLE hProcess = GetCurrentProcess();
BOOL result = FALSE;
+ if (IsDeveloperModeEnabled()) {
+ CAMLreturn(Val_true);
+ }
+
if (OpenProcessToken(hProcess, TOKEN_READ, &hProcess)) {
LUID seCreateSymbolicLinkPrivilege;
external waitpid : wait_flag list -> int -> int * process_status
= "win_waitpid"
+external _exit : int -> 'a = "unix_exit"
external getpid : unit -> int = "unix_getpid"
let fork () = invalid_arg "Unix.fork not implemented"
tm_yday : int;
tm_isdst : bool }
-external time : unit -> float = "unix_time"
-external gettimeofday : unit -> float = "unix_gettimeofday"
+external time : unit -> (float [@unboxed]) =
+ "unix_time" "unix_time_unboxed" [@@noalloc]
+external gettimeofday : unit -> (float [@unboxed]) =
+ "unix_gettimeofday" "unix_gettimeofday_unboxed" [@@noalloc]
external gmtime : float -> tm = "unix_gmtime"
external localtime : float -> tm = "unix_localtime"
external mktime : tm -> float * tm = "unix_mktime"
| SO_ACCEPTCONN
| TCP_NODELAY
| IPV6_ONLY
+ | SO_REUSEPORT
type socket_int_option =
SO_SNDBUF
{ ERROR_WRITE_PROTECT,
ERROR_SHARING_BUFFER_EXCEEDED - ERROR_WRITE_PROTECT,
EACCES },
+ { ERROR_PRIVILEGE_NOT_HELD, 0, EPERM},
{ WSAEINVAL, 0, EINVAL },
{ WSAEACCES, 0, EACCES },
{ WSAEBADF, 0, EBADF },
FILE_SHARE_READ | FILE_SHARE_WRITE,
NULL,
OPEN_EXISTING,
- 0,
+ FILE_FLAG_BACKUP_SEMANTICS,
NULL);
caml_leave_blocking_section();
caml_stat_free(wpath);
module Type:
sig
val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text ->
- ?params:(core_type * variance) list ->
+ ?params:(core_type * (variance * injectivity)) list ->
?cstrs:(core_type * core_type * loc) list ->
?kind:type_kind -> ?priv:private_flag -> ?manifest:core_type -> str ->
type_declaration
module Te:
sig
val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs ->
- ?params:(core_type * variance) list -> ?priv:private_flag ->
- lid -> extension_constructor list -> type_extension
+ ?params:(core_type * (variance * injectivity)) list ->
+ ?priv:private_flag -> lid -> extension_constructor list -> type_extension
val mk_exception: ?loc:loc -> ?attrs:attrs -> ?docs:docs ->
extension_constructor -> type_exception
module Ci:
sig
val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text ->
- ?virt:virtual_flag -> ?params:(core_type * variance) list ->
+ ?virt:virtual_flag ->
+ ?params:(core_type * (variance * injectivity)) list ->
str -> 'a -> 'a class_infos
end
type variance =
| Covariant
| Contravariant
- | Invariant
+ | NoVariance
+
+type injectivity =
+ | Injective
+ | NoInjectivity
(* Warn for unused and ambiguous docstrings *)
let warn_bad_docstrings () =
- if Warnings.is_active (Warnings.Bad_docstring true) then begin
+ if Warnings.is_active (Warnings.Unexpected_docstring true) then begin
List.iter
(fun ds ->
match ds.ds_attached with
| Info -> ()
| Unattached ->
- prerr_warning ds.ds_loc (Warnings.Bad_docstring true)
+ prerr_warning ds.ds_loc (Warnings.Unexpected_docstring true)
| Docs ->
match ds.ds_associated with
| Zero | One -> ()
| Many ->
- prerr_warning ds.ds_loc (Warnings.Bad_docstring false))
+ prerr_warning ds.ds_loc (Warnings.Unexpected_docstring false))
(List.rev !docstrings)
end
let uppercase_latin1 = ['A'-'Z' '\192'-'\214' '\216'-'\222']
let identchar_latin1 =
['A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255' '\'' '0'-'9']
+(* This should be kept in sync with the [is_identchar] function in [env.ml] *)
+
let symbolchar =
['!' '$' '%' '&' '*' '+' '-' '.' '/' ':' '<' '=' '>' '?' '@' '^' '|' '~']
let dotsymbolchar =
['!' '$' '%' '&' '*' '+' '-' '/' ':' '=' '>' '?' '@' '^' '|']
+let symbolchar_or_hash =
+ symbolchar | '#'
let kwdopchar =
['$' '&' '*' '+' '-' '/' '<' '=' '>' '@' '^' '|']
| "-" { MINUS }
| "-." { MINUSDOT }
- | "!" symbolchar + as op
+ | "!" symbolchar_or_hash + as op
{ PREFIXOP op }
- | ['~' '?'] symbolchar + as op
+ | ['~' '?'] symbolchar_or_hash + as op
{ PREFIXOP op }
| ['=' '<' '>' '|' '&' '$'] symbolchar * as op
{ INFIXOP0 op }
| '%' { PERCENT }
| ['*' '/' '%'] symbolchar * as op
{ INFIXOP3 op }
- | '#' (symbolchar | '#') + as op
+ | '#' symbolchar_or_hash + as op
{ HASHOP op }
| "let" kwdopchar dotsymbolchar * as op
{ LETOP op }
List.exists (fun ((_, s), (_, e)) -> s <= pos && pos <= e) iset
let find_bound_in iset ~range:(start, end_) =
- Misc.Stdlib.List.find_map (fun ((a, x), (b, y)) ->
+ List.find_map (fun ((a, x), (b, y)) ->
if start <= x && x <= end_ then Some (a, x)
else if start <= y && y <= end_ then Some (b, y)
else None
) iset
let is_start iset ~pos =
- Misc.Stdlib.List.find_map (fun ((a, x), _) ->
+ List.find_map (fun ((a, x), _) ->
if pos = x then Some a else None
) iset
let is_end iset ~pos =
- Misc.Stdlib.List.find_map (fun (_, (b, y)) ->
+ List.find_map (fun (_, (b, y)) ->
if pos = y then Some b else None
) iset
val longident: Lexing.lexbuf -> Longident.t
(**
- The function [longident] is guaranted to parse all subclasses
+ The function [longident] is guaranteed to parse all subclasses
of {!Longident.t} used in OCaml: values, constructors, simple or extended
module paths, and types or module types.
Location.loc_ghost = true;
}
-let mktyp ~loc d = Typ.mk ~loc:(make_loc loc) d
+let mktyp ~loc ?attrs d = Typ.mk ~loc:(make_loc loc) ?attrs d
let mkpat ~loc d = Pat.mk ~loc:(make_loc loc) d
let mkexp ~loc d = Exp.mk ~loc:(make_loc loc) d
let mkmty ~loc ?attrs d = Mty.mk ~loc:(make_loc loc) ?attrs d
let mkpat_opt_constraint ~loc p = function
| None -> p
- | Some typ -> mkpat ~loc (Ppat_constraint(p, typ))
+ | Some typ -> ghpat ~loc (Ppat_constraint(p, typ))
let syntax_error () =
raise Syntaxerr.Escape_error
let lident x = Lident x
let ldot x y = Ldot(x,y)
let dotop_fun ~loc dotop =
- (* We could use ghexp here, but sticking to mkexp for parser.mly
- compatibility. TODO improve parser.mly *)
- mkexp ~loc (Pexp_ident (ghloc ~loc dotop))
+ ghexp ~loc (Pexp_ident (ghloc ~loc dotop))
let array_function ~loc str name =
ghloc ~loc (Ldot(Lident str,
else raise (Syntaxerr.Error(
Syntaxerr.Applicative_path (make_loc loc)))
-let exp_of_longident ~loc lid =
- mkexp ~loc (Pexp_ident {lid with txt = Lident(Longident.last lid.txt)})
-
(* [loc_map] could be [Location.map]. *)
let loc_map (f : 'a -> 'b) (x : 'a Location.loc) : 'b Location.loc =
{ x with txt = f x.txt }
+let make_ghost x = { x with loc = { x.loc with loc_ghost = true }}
+
let loc_last (id : Longident.t Location.loc) : string Location.loc =
loc_map Longident.last id
let loc_lident (id : string Location.loc) : Longident.t Location.loc =
loc_map (fun x -> Lident x) id
+let exp_of_longident ~loc lid =
+ let lid = make_ghost (loc_map (fun id -> Lident (Longident.last id)) lid) in
+ ghexp ~loc (Pexp_ident lid)
+
let exp_of_label ~loc lbl =
mkexp ~loc (Pexp_ident (loc_lident lbl))
-let pat_of_label ~loc lbl =
- mkpat ~loc (Ppat_var (loc_last lbl))
+let pat_of_label lbl =
+ Pat.mk ~loc:lbl.loc (Ppat_var (loc_last lbl))
let mk_newtypes ~loc newtypes exp =
let mkexp = mkexp ~loc in
let text_sig pos = Sig.text (rhs_text pos)
let text_cstr pos = Cf.text (rhs_text pos)
let text_csig pos = Ctf.text (rhs_text pos)
-let text_def pos = [Ptop_def (Str.text (rhs_text pos))]
+let text_def pos =
+ List.map (fun def -> Ptop_def [def]) (Str.text (rhs_text pos))
let extra_text startpos endpos text items =
match items with
let extra_cstr p1 p2 items = extra_text p1 p2 Cf.text items
let extra_csig p1 p2 items = extra_text p1 p2 Ctf.text items
let extra_def p1 p2 items =
- extra_text p1 p2 (fun txt -> [Ptop_def (Str.text txt)]) items
+ extra_text p1 p2
+ (fun txt -> List.map (fun def -> Ptop_def [def]) (Str.text txt))
+ items
let extra_rhs_core_type ct ~pos =
let docs = rhs_info pos in
err pmty.pmty_loc "only 'with type t =' constraints are supported"
in
match pmty with
- | {pmty_desc = Pmty_ident lid} -> (lid, [])
+ | {pmty_desc = Pmty_ident lid} -> (lid, [], pmty.pmty_attributes)
| {pmty_desc = Pmty_with({pmty_desc = Pmty_ident lid}, cstrs)} ->
- (lid, List.map map_cstr cstrs)
+ (lid, List.map map_cstr cstrs, pmty.pmty_attributes)
| _ ->
err pmty.pmty_loc
"only module type identifier and 'with type' constraints are supported"
functor_arg:
(* An anonymous and untyped argument. *)
LPAREN RPAREN
- { Unit }
+ { $startpos, Unit }
| (* An argument accompanied with an explicit type. *)
LPAREN x = mkrhs(module_name) COLON mty = module_type RPAREN
- { Named (x, mty) }
+ { $startpos, Named (x, mty) }
;
module_name:
{ unclosed "struct" $loc($1) "end" $loc($4) }
| FUNCTOR attrs = attributes args = functor_args MINUSGREATER me = module_expr
{ wrap_mod_attrs ~loc:$sloc attrs (
- List.fold_left (fun acc arg ->
- mkmod ~loc:$sloc (Pmod_functor (arg, acc))
+ List.fold_left (fun acc (startpos, arg) ->
+ mkmod ~loc:(startpos, $endpos) (Pmod_functor (arg, acc))
) me args
) }
| me = paren_module_expr
| mkmod(
COLON mty = module_type EQUAL me = module_expr
{ Pmod_constraint(me, mty) }
- | arg = functor_arg body = module_binding_body
- { Pmod_functor(arg, body) }
+ | arg_and_pos = functor_arg body = module_binding_body
+ { let (_, arg) = arg_and_pos in
+ Pmod_functor(arg, body) }
) { $1 }
;
MINUSGREATER mty = module_type
%prec below_WITH
{ wrap_mty_attrs ~loc:$sloc attrs (
- List.fold_left (fun acc arg ->
- mkmty ~loc:$sloc (Pmty_functor (arg, acc))
+ List.fold_left (fun acc (startpos, arg) ->
+ mkmty ~loc:(startpos, $endpos) (Pmty_functor (arg, acc))
) mty args
) }
| MODULE TYPE OF attributes module_expr %prec below_LBRACKETAT
COLON mty = module_type
{ mty }
| mkmty(
- arg = functor_arg body = module_declaration_body
- { Pmty_functor(arg, body) }
+ arg_and_pos = functor_arg body = module_declaration_body
+ { let (_, arg) = arg_and_pos in
+ Pmty_functor(arg, body) }
)
{ $1 }
;
| let_bindings(no_ext) IN class_expr
{ class_of_let_bindings ~loc:$sloc $1 $3 }
| LET OPEN override_flag attributes mkrhs(mod_longident) IN class_expr
- { let loc = ($startpos($2), $endpos($4)) in
+ { let loc = ($startpos($2), $endpos($5)) in
let od = Opn.mk ~override:$3 ~loc:(make_loc loc) $5 in
mkclass ~loc:$sloc ~attrs:$4 (Pcl_open(od, $7)) }
| class_expr attribute
| class_signature attribute
{ Cty.attr $1 $2 }
| LET OPEN override_flag attributes mkrhs(mod_longident) IN class_signature
- { let loc = ($startpos($2), $endpos($4)) in
+ { 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)) }
;
| extension
{ Pexp_extension $1 }
| od=open_dot_declaration DOT mkrhs(LPAREN RPAREN {Lident "()"})
- { (* TODO: review the location of Pexp_construct *)
- Pexp_open(od, mkexp ~loc:$sloc (Pexp_construct($3, None))) }
+ { Pexp_open(od, mkexp ~loc:($loc($3)) (Pexp_construct($3, None))) }
| mod_longident DOT LPAREN seq_expr error
{ unclosed "(" $loc($3) ")" $loc($5) }
| LBRACE record_expr_content RBRACE
{ unclosed "{" $loc($1) "}" $loc($3) }
| od=open_dot_declaration DOT LBRACE record_expr_content RBRACE
{ let (exten, fields) = $4 in
- (* TODO: review the location of Pexp_construct *)
- Pexp_open(od, mkexp ~loc:$sloc (Pexp_record(fields, exten))) }
+ Pexp_open(od, mkexp ~loc:($startpos($3), $endpos)
+ (Pexp_record(fields, exten))) }
| mod_longident DOT LBRACE record_expr_content error
{ unclosed "{" $loc($3) "}" $loc($5) }
| LBRACKETBAR expr_semi_list BARRBRACKET
| LBRACKETBAR BARRBRACKET
{ Pexp_array [] }
| od=open_dot_declaration DOT LBRACKETBAR expr_semi_list BARRBRACKET
- { (* TODO: review the location of Pexp_array *)
- Pexp_open(od, mkexp ~loc:$sloc (Pexp_array($4))) }
+ { Pexp_open(od, mkexp ~loc:($startpos($3), $endpos) (Pexp_array($4))) }
| od=open_dot_declaration DOT LBRACKETBAR BARRBRACKET
{ (* TODO: review the location of Pexp_array *)
- Pexp_open(od, mkexp ~loc:$sloc (Pexp_array [])) }
+ Pexp_open(od, mkexp ~loc:($startpos($3), $endpos) (Pexp_array [])) }
| mod_longident DOT
LBRACKETBAR expr_semi_list error
{ unclosed "[|" $loc($3) "|]" $loc($5) }
{ let list_exp =
(* TODO: review the location of list_exp *)
let tail_exp, _tail_loc = mktailexp $loc($5) $4 in
- mkexp ~loc:$sloc tail_exp in
+ mkexp ~loc:($startpos($3), $endpos) tail_exp in
Pexp_open(od, list_exp) }
| od=open_dot_declaration DOT mkrhs(LBRACKET RBRACKET {Lident "[]"})
- { (* TODO: review the location of Pexp_construct *)
- Pexp_open(od, mkexp ~loc:$sloc (Pexp_construct($3, None))) }
+ { Pexp_open(od, mkexp ~loc:$loc($3) (Pexp_construct($3, None))) }
| mod_longident DOT
LBRACKET expr_semi_list error
{ unclosed "[" $loc($3) "]" $loc($5) }
| od=open_dot_declaration DOT LPAREN MODULE ext_attributes module_expr COLON
package_type RPAREN
- { (* TODO: review the location of Pexp_constraint *)
- let modexp =
- mkexp_attrs ~loc:$sloc
+ { let modexp =
+ mkexp_attrs ~loc:($startpos($3), $endpos)
(Pexp_constraint (ghexp ~loc:$sloc (Pexp_pack $6), $8)) $5 in
Pexp_open(od, modexp) }
| mod_longident DOT
{ mkpat_attrs ~loc:$sloc (Ppat_unpack $4) $3 }
| LPAREN MODULE ext_attributes mkrhs(module_name) COLON package_type RPAREN
{ mkpat_attrs ~loc:$sloc
- (Ppat_constraint(mkpat ~loc:$sloc (Ppat_unpack $4), $6))
+ (Ppat_constraint(mkpat ~loc:$loc($4) (Ppat_unpack $4), $6))
$3 }
| mkpat(simple_pattern_not_ident_)
{ $1 }
label = mkrhs(label_longident)
octy = preceded(COLON, core_type)?
opat = preceded(EQUAL, pattern)?
- { let pat =
+ { let label, pat =
match opat with
| None ->
- (* No pattern; this is a pun. Desugar it. *)
- pat_of_label ~loc:$sloc label
+ (* 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
| Some pat ->
- pat
+ label, pat
in
label, mkpat_opt_constraint ~loc:$sloc pat octy
}
;
type_variance:
- /* empty */ { Invariant }
- | PLUS { Covariant }
- | MINUS { Contravariant }
+ /* empty */ { NoVariance, NoInjectivity }
+ | PLUS { Covariant, NoInjectivity }
+ | MINUS { Contravariant, NoInjectivity }
+ | BANG { NoVariance, Injective }
+ | PLUS BANG | BANG PLUS { Covariant, Injective }
+ | MINUS BANG | BANG MINUS { Contravariant, Injective }
+ | INFIXOP2
+ { if $1 = "+!" then Covariant, Injective else
+ if $1 = "-!" then Contravariant, Injective else
+ expecting $loc($1) "type_variance" }
+ | PREFIXOP
+ { if $1 = "!+" then Covariant, Injective else
+ if $1 = "!-" then Contravariant, Injective else
+ expecting $loc($1) "type_variance" }
;
(* A sequence of constructor declarations is either a single BAR, which
attrs2 = attributes
attrs = post_item_attributes
{ let args, res = args_res in
- let loc = make_loc $sloc 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)
{ tys }
;
-%inline package_type:
- mktyp(module_type
- { Ptyp_package (package_type_of_module_type $1) })
- { $1 }
+%inline package_type: module_type
+ { let (lid, cstrs, attrs) = package_type_of_module_type $1 in
+ let descr = Ptyp_package (lid, cstrs) in
+ mktyp ~loc:$sloc ~attrs descr }
;
%inline row_field_list:
separated_nonempty_llist(BAR, row_field)
(see 4.2 in the manual)
*)
| Rinherit of core_type
- (* [ T ] *)
+ (* [ | t ] *)
and object_field = {
pof_desc : object_field_desc;
and type_declaration =
{
ptype_name: string loc;
- ptype_params: (core_type * variance) list;
+ ptype_params: (core_type * (variance * injectivity)) list;
(* ('a1,...'an) t; None represents _*)
ptype_cstrs: (core_type * core_type * Location.t) list;
(* ... constraint T1=T1' ... constraint Tn=Tn' *)
and type_extension =
{
ptyext_path: Longident.t loc;
- ptyext_params: (core_type * variance) list;
+ ptyext_params: (core_type * (variance * injectivity)) list;
ptyext_constructors: extension_constructor list;
ptyext_private: private_flag;
ptyext_loc: Location.t;
and 'a class_infos =
{
pci_virt: virtual_flag;
- pci_params: (core_type * variance) list;
+ pci_params: (core_type * (variance * injectivity)) list;
pci_name: string loc;
pci_expr: 'a;
pci_loc: Location.t;
(* variance encoding: need to sync up with the [parser.mly] *)
let type_variance = function
- | Invariant -> ""
+ | NoVariance -> ""
| Covariant -> "+"
| Contravariant -> "-"
+let type_injectivity = function
+ | NoInjectivity -> ""
+ | Injective -> "!"
+
type construct =
[ `cons of expression list
| `list of expression list
| _ -> list ~first:"(" ~last:")@;" (core_type ctxt) ~sep:",@;" f l)
l longident_loc li
| Ptyp_variant (l, closed, low) ->
+ let first_is_inherit = match l with
+ | {Parsetree.prf_desc = Rinherit _}::_ -> true
+ | _ -> false in
let type_variant_helper f x =
match x.prf_desc with
| Rtag (l, _, ctl) ->
| _ ->
pp f "%s@;%a"
(match (closed,low) with
- | (Closed,None) -> ""
+ | (Closed,None) -> if first_is_inherit then " |" else ""
| (Closed,Some _) -> "<" (* FIXME desugar the syntax sugar*)
| (Open,_) -> ">")
(list type_variant_helper ~sep:"@;<1 -2>| ") l) l
(********************pattern********************)
(* be cautious when use [pattern], [pattern1] is preferred *)
and pattern ctxt f x =
- let rec list_of_pattern acc = function (* only consider ((A|B)|C)*)
- | {ppat_desc= Ppat_or (p1,p2); ppat_attributes = []} ->
- list_of_pattern (p2::acc) p1
- | x -> x::acc
- in
if x.ppat_attributes <> [] then begin
pp f "((%a)%a)" (pattern ctxt) {x with ppat_attributes=[]}
(attributes ctxt) x.ppat_attributes
end
else match x.ppat_desc with
| Ppat_alias (p, s) ->
- pp f "@[<2>%a@;as@;%a@]" (pattern ctxt) p protect_ident s.txt (* RA*)
- | Ppat_or _ -> (* *)
- pp f "@[<hov0>%a@]" (list ~sep:"@,|" (pattern ctxt))
- (list_of_pattern [] x)
- | _ -> pattern1 ctxt f x
+ pp f "@[<2>%a@;as@;%a@]" (pattern ctxt) p protect_ident s.txt
+ | _ -> pattern_or ctxt f x
+
+and pattern_or ctxt f x =
+ let rec left_associative x acc = match x with
+ | {ppat_desc=Ppat_or (p1,p2); ppat_attributes = []} ->
+ left_associative p1 (p2 :: acc)
+ | x -> x :: acc
+ in
+ match left_associative x [] with
+ | [] -> assert false
+ | [x] -> pattern1 ctxt f x
+ | orpats ->
+ pp f "@[<hov0>%a@]" (list ~sep:"@ | " (pattern1 ctxt)) orpats
and pattern1 ctxt (f:Format.formatter) (x:pattern) : unit =
let rec pattern_list_helper f = function
(expression ctxt) e
(item_attributes ctxt) attrs
| PStr x -> structure ctxt f x
- | PTyp x -> pp f ":"; core_type ctxt f x
- | PSig x -> pp f ":"; signature ctxt f x
- | PPat (x, None) -> pp f "?"; pattern ctxt f x
+ | PTyp x -> pp f ":@ "; core_type ctxt f x
+ | PSig x -> pp f ":@ "; signature ctxt f x
+ | PPat (x, None) -> pp f "?@ "; pattern ctxt f x
| PPat (x, Some e) ->
- pp f "?"; pattern ctxt f x;
+ pp f "?@ "; pattern ctxt f x;
pp f " when "; expression ctxt f e
(* transform [f = fun g h -> ..] to [f g h = ... ] could be improved *)
Some (p, pt_tyvars, e_ct, e) else None
| _ -> None in
if x.pexp_attributes <> []
- then pp f "%a@;=@;%a" (pattern ctxt) p (expression ctxt) x else
+ then
+ match p with
+ | {ppat_desc=Ppat_constraint({ppat_desc=Ppat_var _; _} as pat,
+ ({ptyp_desc=Ptyp_poly _; _} as typ));
+ ppat_attributes=[]; _} ->
+ pp f "%a@;: %a@;=@;%a"
+ (simple_pattern ctxt) pat (core_type ctxt) typ (expression ctxt) x
+ | _ ->
+ pp f "%a@;=@;%a" (pattern ctxt) p (expression ctxt) x
+ else
match is_desugared_gadt p x with
| Some (p, [], ct, e) ->
pp f "%a@;: %a@;=@;%a"
item_extension ctxt f e;
item_attributes ctxt f a
-and type_param ctxt f (ct, a) =
- pp f "%s%a" (type_variance a) (core_type ctxt) ct
+and type_param ctxt f (ct, (a,b)) =
+ pp f "%s%s%a" (type_variance a) (type_injectivity b) (core_type ctxt) ct
and type_params ctxt f = function
| [] -> ()
| Pext_decl(l, r) ->
constructor_declaration ctxt f (x.pext_name.txt, l, r, x.pext_attributes)
| Pext_rebind li ->
- pp f "%s%a@;=@;%a" x.pext_name.txt
- (attributes ctxt) x.pext_attributes
+ pp f "%s@;=@;%a%a" x.pext_name.txt
longident_loc li
+ (attributes ctxt) x.pext_attributes
and case_list ctxt f l : unit =
let aux f {pc_lhs; pc_guard; pc_rhs} =
--- /dev/null
+OCaml 4.10.0 (21 February 2020)
+-------------------------------
+
+- New best-fit allocator for the major heap
+- Preliminary runtime work for OCaml multicore
+- Immutable strings are now enforced at configuration time
+- User-defined indexing operators for multidimensional arrays
+- Coming soon: statmemprof, a new statistical memory profiler.
+- The external API will be released next version.
+- Various improvements to the manual
+- More precise exhaustiveness check for GADTs
+- Many bug fixes
+
+
+OCaml 4.09.1 (18 March 2020)
+----------------------------
+
+Bug fixes.
+
+OCaml 4.09.0 (18 September 2019)
+--------------------------------
+
+- New optimisations, in particular for affine functions in matches,
+ for instance:
+
+ type t = A | B | C
+ let affine = function
+ | A -> 4
+ | B -> 3
+ | C -> 2
+
+- The `graphics` library was moved out of the compiler distribution.
+- The `vmthread` library was removed.
+- Support for compiler plugins was removed.
+- Many bug fixes.
+
+OCaml 4.08.1 (5 August 2019)
+----------------------------
+
+Bug fixes.
+
+OCaml 4.08.0 (14 June 2019)
+---------------------------
+
+- Binding operators (let*, let+, and*, etc). They can be used to
+ streamline monadic code.
+
+- `open` now applies to arbitrary module expression in structures and
+ to applicative paths in signatures.
+
+- A new notion of (user-defined) "alerts" generalizes the deprecated
+ warning.
+
+- New modules in the standard library: Fun, Bool, Int, Option, Result.
+
+- A significant number of new functions in Float, including FMA
+ support, and a new Float.Array submodule.
+
+- Source highlighting for errors and warnings in batch mode.
+
+- Many error messages were improved.
+
+- Improved AFL instrumentation for objects and lazy values.
+
+
+OCaml 4.07.1 (4 October 2018)
+-----------------------------
+
+This release consists mostly of bug fixes. The most salient bugs were
+
+- MPR#7820, GPR#1897: a bug in Array.of_seq (new in 4.07)
+ (Thierry Martinez, review by Nicolás Ojeda Bär)
+
+- MPR#7815, GPR#1896: crash in the major GC with the first-fit policy
+ (Stephen Dolan and Damien Doligez, report by Joris Giovannangeli)
+
+- MPR#7821, GPR#1908: the compiler loads more cmi, which breaks some builds
+ (Jérémie Dimino, review by Gabriel Scherer)
+
+- MPR#7833, GPR#1946: typechecking failure (regression) on large GADT matchings
+ (Thomas Refis, report by Jerome Simeon, review by Jacques Garrigue)
+
+See the detailed list of fixes at (Changes#4.07.1).
+
+
+OCaml 4.07.0 (10 July 2018):
+----------------------------
+
+Some highlights of this release are:
+
+- The way the standard library modules are organized internally has
+ changed (GPR#1010, by Jérémie Dimino):
+
+ 1. the `List` module (for example) is now named `Stdlib__list`
+ 2. a new Stdlib module contains a series of aliases
+ such as `module List = Stdlib__list`
+ 3. the `Stdlib` module is implicitly opened when type-checking OCaml
+ programs (as `Pervasives` previously was), so that `Stdlib.List` can be
+ accessed as just `List`, as before.
+
+ This should be invisible to most users, although it is possible that
+ some tools show the `Stdlib.` or `Stdlib__` prefixes in
+ messages. (You might want to report these situations as usability
+ bugs.) The change prevents standard library modules from conflicting
+ with end-user filenames (please avoid `stdlib.ml` and the
+ `Stdlib__` prefix); we may introduce new standard library modules in
+ the future with less fear of breaking user code. In particular,
+ `Float` (GPR#1638, by Nicolás Ojeda Bär) and `Seq` (GPR#1002, by
+ Simon Cruanes) modules have now been added to the standard library.
+
+- The error messages caused by various typing errors have been improved
+ to be easier to understand, in particular for beginners.
+ (GPR#1505, GPR#1510, by Arthur Charguéreau and Armaël Guéneau)
+
+ For example,
+
+ # while 1 do () done;;
+ ^
+ Error: This expression has type int but
+ an expression was expected of type bool
+
+ now adds the extra explanation
+
+ because it is in the condition of a while-loop
+
+- Effort has been made to reduce the compilation time of flambda
+ programs, and the size of the produced `.cmx` files when using
+ the -Oclassic optimisation level.
+ (GPR#1401, GPR#1455, GPR#1627, GPR#1665, by Pierre Chambart, Xavier
+ Clerc, Fuyong Quah, and Leo White)
+
+- The HTML manual has benefited from various style improvements
+ and should look visually nicer than previous editions.
+ (GPR#1741, GPR#1757, GPR#1767 by Charles Chamberlain and steinuil)
+
+ The new version of the manual can be consulted at
+ <http://caml.inria.fr/pub/docs/manual-ocaml-4.07/>; see the
+ previous version for comparison at
+ <http://caml.inria.fr/pub/docs/manual-ocaml-4.06/>.
+
+- Since 4.01, it is possible to select a variant constructor or
+ record field from a sub-module that is not opened in the current
+ scope, if type information is available at the point of use. This
+ now also works for GADT constructors.
+ (GPR#1648, by Thomas Refis and Leo White)
+
+- The GC should handle the accumulation of custom blocks in the minor
+ heap better; this solves some memory-usage issues observed by code
+ which allocates a lot of small custom blocks, typically small bigarrays
+ (GPR#1476, by Alain Frsich)
+
+See also the detailed list of changes: (Changes#4.07.0).
+
+
+OCaml 4.06.1 (16 Feb 2018):
+---------------------------
+
+This release consists mostly of bug fixes. The most salient bugs were
+
+- An incorrect compilation of pattern-matching in presence of
+ extensible variant constructors (such as exceptions), that had been
+ present for a long time.
+ (GPR#1459, GPR#1538, by Luc Maranget, Thomas Refis and Gabriel Scherer)
+
+- An optimization of `not (x = y)` into `x <> y`, introduced in
+ 4.06.0, is incorrect on floating-point numbers in the `nan`
+ case. (GPR#1470, by Leo White)
+
+See the detailed list of fixes at (Changes#4.06.1).
+
+
+OCaml 4.06.0 (3 Nov 2017):
+--------------------------
+
+- Strings (type `string`) are now immutable by default. In-place
+ modification must use the type `bytes` of byte sequences, which is
+ distinct from `string`. This corresponds to the `-safe-string`
+ compile-time option, which was introduced in OCaml 4.02 in 2014, and
+ which is now the default.
+ (GPR#1252, by Damien Doligez)
+
+- Object types can now extend a previously-defined object type,
+ as in `<t; a: int>`.
+ (GPR#1118, by Runhang Li)
+
+- Destructive substitution over module signatures can now express more
+ substitutions, such as `S with type M.t := type-expr` and `S with
+ module M.N := path`.
+ (GPR#792, by Valentin Gatien-Baron)
+
+- Users can now define operators that look like array indexing,
+ e.g. `let ( .%() ) = List.nth in [0; 1; 2].%(1)`
+ (GPR#1064, GPR#1392, by Florian Angeletti)
+
+- New escape `\u{XXXX}` in string literals, denoting the UTF-8
+ encoding of the Unicode code point `XXXX`.
+ (GPR#1232, by Daniel Bünzli)
+
+- Full Unicode support was added to the Windows runtime system. In
+ particular, file names can now contain Unicode characters.
+ (GPR#153, GPR#1200, GPR#1357, GPR#1362, GPR#1363, GPR#1369, GPR#1398,
+ GPR#1446, GPR#1448, by ygrek and Nicolás Ojeda Bär)
+
+- An alternate register allocator based on linear scan can be selected
+ with `ocamlopt -linscan`. It reduces compilation time compared with
+ the default register allocator.
+ (GPR#375, Marcell Fischbach and Benedikt Meurer)
+
+- The Num library for arbitrary-precision integer and rational
+ arithmetic is no longer part of the core distribution and can be
+ found as a separate OPAM package.
+
+See the detailed list of changes: (Changes#4.06.0).
+
+
+OCaml 4.05.0 (13 Jul 2017):
+---------------------------
+
+Some highlights include:
+
+- Instrumentation support for fuzzing with afl-fuzz.
+ (GPR#504, by Stephen Dolan)
+
+- The compilers now accept new `-args/-args0 <file>` command-line
+ parameters to provide extra command-line arguments in a file. User
+ programs may implement similar options using the new `Expand`
+ constructor of the `Arg` module.
+ (GPR#748, GPR#843, GPR#864, by Bernhard Schommer)
+
+- Many functions of the standard library that raise an exception now
+ have an option-returning variable suffixed by `_opt` Typical
+ examples of the new functions include:
+
+ int_of_string_opt: string -> int option
+ List.nth_opt: 'a list -> int -> 'a option
+ Hashtbl.find_opt : ('a, 'b) t -> 'a -> 'b option
+
+ (GPR#885, by Alain Frisch)
+
+- The security of the runtime system is now hardened by using `secure_getenv`
+ to access environment variables whenever its possible, to avoid unplanned
+ privilege-escalation when running setuid binaries.
+ (GPR#1213, by Damien Doligez)
+
+See the detailed list of changes: (Changes#4.05.0).
--- /dev/null
+These are informal notes on how to do an OCaml release.
+
+Following these steps requires commit right in the OCaml repository,
+as well as SSH access to the inria.fr file servers hosting the
+distribution archives and manual.
+
+We are not fully confident that those steps are correct, feel free to
+check with other release managers in case of doubt.
+
+Note: we say that a new release is a "testing release" if it is a Beta
+version or Release Candidate. Otherwise, we call it a "production
+release".
+
+
+## A few days in advance
+
+Send a mail on caml-devel to warn Gabriel (to make a pass on Changes;
+see the "Changes curation" appendix for more details) and the
+OCamlLabs folks (for OPAM testing).
+
+## 0: release environment setup
+
+```
+rm -f /tmp/env-$USER.sh
+cat >/tmp/env-$USER.sh <<EOF
+# Update the data below
+export MAJOR=4
+export MINOR=08
+export BUGFIX=0
+export PLUSEXT=
+
+# names for the release announce
+export HUMAN=
+
+# do we need to use tar or gtar?
+export TAR=tar
+
+export WORKTREE=~/o/\$MAJOR.\$MINOR
+ # must be the git worktree for the branch you are releasing
+
+export BRANCH=\$MAJOR.\$MINOR
+export VERSION=\$MAJOR.\$MINOR.\$BUGFIX\$PLUSEXT
+
+export REPO=https://github.com/ocaml/ocaml
+
+# these values are specific to caml.inria's host setup
+# they are defined in the release manager's .bashrc file
+export ARCHIVE_HOST="$OCAML_RELEASE_ARCHIVE_HOST"
+export ARCHIVE_PATH="$OCAML_RELEASE_ARCHIVE_PATH"
+export WEB_HOST="$OCAML_RELEASE_WEB_HOST"
+export WEB_PATH="$OCAML_RELEASE_WEB_PATH"
+
+export DIST="\$ARCHIVE_PATH/ocaml/ocaml-\$MAJOR.\$MINOR"
+export INSTDIR="/tmp/ocaml-\$VERSION"
+
+
+EOF
+source /tmp/env-$USER.sh
+echo $VERSION
+```
+
+
+## 1: check repository state
+
+```
+cd $WORKTREE
+git checkout $MAJOR.$MINOR
+git status # check that the local repo is in a clean state
+git pull
+```
+
+## 2: magic numbers
+
+If you are about to do a major release, you should check that the
+magic numbers have been updated since the last major release. It is
+preferable to do this just before the first testing release for this
+major version, typically the first beta.
+
+See the `utils/HACKING.adoc` file for documentation on how to bump the
+magic numbers.
+
+## 3: build, refresh dependencies, sanity checks
+
+```
+make distclean
+git clean -n -d -f -x # Check that "make distclean" removed everything
+
+rm -rf ${INSTDIR}
+./configure --prefix=${INSTDIR}
+
+make -j5
+
+# Check that dependencies are up-to-date
+make alldepend
+
+git diff
+# should have empty output
+
+# check that .depend files have no absolute path in them
+find . -name .depend | xargs grep ' /'
+ # must have empty output
+
+# Run the check-typo script
+./tools/check-typo
+
+
+make install
+./tools/check-symbol-names runtime/*.a
+ # must have empty output and return 0
+```
+
+
+## 4: tests
+
+```
+make tests
+```
+
+
+## 5: build, tag and push the new release
+
+```
+# at this point, the VERSION file contains N+devD
+# increment it into N+dev(D+1); for example,
+# 4.07.0+dev8-2018-06-19 => 4.07.0+dev9-2018-06-26
+# for production releases: check and change the Changes header
+# (remove "next version" and add a date)
+make -B configure
+git commit -a -m "last commit before tagging $VERSION"
+
+# update VERSION with the new release; for example,
+# 4.07.0+dev9-2018-06-26 => 4.07.0+rc2
+# Update ocaml-variants.opam with new version.
+# Update \year in manual/manual/macros.hva
+make -B configure
+# For a production release
+make coreboot -j5
+make coreboot -j5 # must say "Fixpoint reached, bootstrap succeeded."
+git commit -m "release $VERSION" -a
+git tag -m "release $VERSION" $VERSION
+
+# for production releases, change the VERSION file into (N+1)+dev0; for example,
+# 4.08.0 => 4.08.1+dev0
+# for testing candidates, use N+dev(D+2) instead; for example,
+# 4.07.0+rc2 => 4.07.0+dev10-2018-06-26
+# Revert ocaml-variants.opam to its "trunk" version.
+make -B configure
+git commit -m "increment version number after tagging $VERSION" VERSION configure ocaml-variants.opam
+git push
+git push --tags
+```
+
+## 5-bis: Alternative for branching
+
+This needs to be more tested, tread with care.
+```
+# at this point, the VERSION file contains N+devD
+# increment it into N+dev(D+1); for example,
+# 4.07.0+dev0-2018-06-19 => 4.07.0+dev1-2018-06-26
+# Rename the "Working version" header in Changes
+# to "OCaml $BRANCH"
+make -B configure
+git commit -a -m "last commit before branching $BRANCH"
+git branch $BRANCH
+
+# update VERSION with the new future branch,
+# 4.07.0+dev1-2018-06-26 => 4.08.0+dev0-2018-06-30
+# Update ocaml-variants.opam with new version.
+make -B configure
+# Add a "Working version" section" to Changes
+# Add common subsections in Changes, see Changelog.
+git commit -m "first commit after branching $VERSION" -a
+git push
+
+# Switch to the new branch
+git checkout $BRANCH
+# increment VERSION, for instance
+# 4.07.0+dev1-2018-06-26 => 4.07.0+dev2-2018-06-30
+make -B configure
+git commit -m "first commit on branch $BRANCH" -a
+git push --set-upstream origin $BRANCH
+```
+
+Adjust github branch settings:
+
+Go to
+ https://github.com/ocaml/ocaml/settings/branches
+and add a rule for protecting the new branch
+(copy the rights from the previous version)
+
+## 5.1: create the release on github (only for a production release)
+
+open https://github.com/ocaml/ocaml/releases
+# and click "Draft a new release"
+# for a minor release, the description is:
+ Bug fixes. See [detailed list of changes](https://github.com/ocaml/ocaml/blob/$MAJOR.$MINOR/Changes).
+
+## 5.3: Inria CI (for a new release branch)
+
+Add the new release branch to the Inria CI list.
+Remove the oldest branch from this list.
+
+## 5.4 new badge in README.adoc (for a new release branch)
+
+Add a badge for the new branch in README.adoc.
+Remove any badge that tracks a version older than Debian stable.
+
+
+## 6: create OPAM packages
+
+Clone the opam-repository
+```
+git clone https://github.com/ocaml/opam-repository
+```
+
+Create a branch for the new release
+```
+git checkout -b OCaml_$VERSION
+```
+
+Create ocaml-variants packages for the new version, copying the particular
+switch configuration choices from the previous version.
+
+Do not forget to add/update the checksum field for the tarballs in the
+"url" section of the opam files. Use opam-lint before sending the pull
+request.
+
+You can test the new opam package before sending a PR to the
+main opam-repository by using the local repository:
+
+```
+opam repo add local /path/to/your/opam-repository
+opam switch create --repo=local,beta=git+https://github.com/ocaml/ocaml-beta-repository.git ocaml-variants.$VERSION
+```
+The switch should build.
+
+For a production release, you also need to create new opam files for the ocaml-manual and
+ocaml-src packages.
+
+## 6.1 Update OPAM dev packages after branching
+
+Create a new ocaml/ocaml.$NEXT/opam file.
+Copy the opam dev files from ocaml-variants/ocaml-variants.$VERSION+trunk*
+into ocaml-variants/ocaml-variants.$NEXT+trunk+* .
+Update the version in those opam files.
+
+Update the synopsis and "src" field in the opam $VERSION packages.
+The "src" field should point to
+ src: "https://github.com/ocaml/ocaml/archive/$VERSION.tar.gz"
+The synopsis should be "latest $VERSION development(,...)".
+
+
+## 7: build the release archives
+
+```
+cd $WORKTREE
+TMPDIR=/tmp/ocaml-release
+git checkout $VERSION
+git checkout-index -a -f --prefix=$TMPDIR/ocaml-$VERSION/
+cd $TMPDIR
+$TAR -c --owner 0 --group 0 -f ocaml-$VERSION.tar ocaml-$VERSION
+gzip -9 <ocaml-$VERSION.tar >ocaml-$VERSION.tar.gz
+xz <ocaml-$VERSION.tar >ocaml-$VERSION.tar.xz
+```
+
+## 8: upload the archives and compute checksums
+
+For the first beta of a major version, create the distribution directory on
+the server:
+```
+ssh $ARCHIVE_HOST "mkdir -p $DIST"
+```
+
+Upload the archives:
+```
+scp ocaml-$VERSION.tar.{xz,gz} $ARCHIVE_HOST:$DIST
+```
+
+To update the checksum files on the remote host, we first upload the
+release environment.
+(note: this assumes the user name is the same on the two machines)
+
+```
+scp /tmp/env-$USER.sh $ARCHIVE_HOST:/tmp/env-$USER.sh
+```
+
+and then login there to update the checksums (MD5SUM, SHA512SUM)
+
+```
+ssh $ARCHIVE_HOST
+source /tmp/env-$USER.sh
+cd $DIST
+
+cp MD5SUM MD5SUM.old
+md5sum ocaml-$VERSION.tar.{xz,gz} > new-md5s
+# check new-md5s to ensure that they look right, and then
+cat new-md5s >> MD5SUM
+# if everything worked well,
+rm MD5SUM.old new-md5s
+
+# same thing for SHA512
+cp SHA512SUM SHA512SUM.old
+sha512sum ocaml-$VERSION.tar.{xz,gz} > new-sha512s
+cat new-sha512s >> SHA512SUM
+rm SHA512SUM.old new-sha512s
+
+# clean up
+rm /tmp/env-$USER.sh
+exit
+```
+
+
+## 9: update note files (technical documentation)
+
+```
+ssh $ARCHIVE_HOST "mkdir -p $DIST/notes"
+cd ocaml-$VERSION
+scp INSTALL.adoc LICENSE README.adoc README.win32.adoc Changes \
+ $ARCHIVE_HOST:$DIST/notes/
+```
+
+
+## 10: upload the reference manual
+
+You don't need to do this if the previous release had the same
+$MAJOR.$MINOR ($BRANCH) value and the exact same manual -- this is frequent if
+it was a release candidate.
+
+```
+cd $WORKTREE
+make
+make install
+export PATH="$INSTDIR/bin:$PATH"
+cd manual
+make clean
+make
+rm -rf /tmp/release
+mkdir -p /tmp/release
+RELEASENAME="ocaml-$BRANCH-"
+make -C manual release RELEASE=/tmp/release/$RELEASENAME
+scp /tmp/release/* $ARCHIVE_HOST:$DIST/
+
+
+# upload manual checksums
+ssh $ARCHIVE_HOST "cd $DIST; md5sum ocaml-$BRANCH-refman* >>MD5SUM"
+ssh $ARCHIVE_HOST "cd $DIST; sha512sum ocaml-$BRANCH-refman* >>SHA512SUM"
+```
+
+Releasing the manual online happens on another machine:
+Do this ONLY FOR A PRODUCTION RELEASE
+
+```
+scp /tmp/env-$USER.sh $ARCHIVE_HOST:/tmp/env-$USER.sh
+ssh $ARCHIVE_HOST
+source /tmp/env-$USER.sh
+scp /tmp/env-$USER.sh $WEB_HOST:/tmp
+ssh $WEB_HOST
+source /tmp/env-$USER.sh
+
+cd $WEB_PATH/caml/pub/docs
+mkdir -p manual-ocaml-$BRANCH
+cd manual-ocaml-$BRANCH
+rm -fR htmlman ocaml-$BRANCH-refman-html.tar.gz
+wget http://caml.inria.fr/pub/distrib/ocaml-$BRANCH/ocaml-$BRANCH-refman-html.tar.gz
+tar -xzvf ocaml-$BRANCH-refman-html.tar.gz # this extracts into htmlman/
+/bin/cp -r htmlman/* . # move HTML content to docs/manual-caml-$BRANCH
+rm -fR htmlman ocaml-$BRANCH-refman-html.tar.gz
+
+cd $WEB_PATH/caml/pub/docs
+rm manual-ocaml
+ln -sf manual-ocaml-$BRANCH manual-ocaml
+```
+
+
+## 11: prepare web announce for the release
+
+For production releases, you should get in touch with ocaml.org to
+organize the webpage for the new release. See
+
+ <https://github.com/ocaml/ocaml.org/issues/819>
+
+
+## 13: announce the release on caml-list, caml-announce, and discuss.ocaml.org
+
+See the email announce templates in the `templates/` directory.
+
+
+
+# Appendix
+
+## Announce templates
+
+See
+
+- templates/beta.md for alpha and beta releases
+- templates/rc.md for release candidate
+- templates/production.md for the production release
+
+
+## Changelog template for a new version
+
+A list of common subsection for the "Changes" file:
+
+```
+### Language features:
+
+### Runtime system:
+
+### Code generation and optimizations:
+
+### Standard library:
+
+### Other libraries:
+
+### Tools:
+
+### Manual and documentation:
+
+### Compiler user-interface and warnings:
+
+### Internal/compiler-libs changes:
+
+### Build system:
+
+### Bug fixes:
+```
+
+
+## Changes curation
+
+Here is the process that Gabriel uses to curate the Changes entries of
+a release in preparation. Feel free to take care of it if you wish.
+
+(In theory it would be possible to maintain the Changes in excellent
+ shape so that no curation would be necessary. In practice it is less
+ work and less friction to tolerate imperfect Changes entries, and
+ curate them before the release.)
+
+### Synchronizing the trunk Changes with release branches
+
+The Changes entries of a release branch or past release should be
+exactly included in the trunk Changes, in the section of this release
+(or release branch). Use an interactive diffing tool (for example
+"meld") to compare and synchronize the Changes files of trunk and
+release branches.
+
+Here are typical forms of divergence and their usual solutions:
+
+- A change entry is present in a different section in two branches.
+ (Typically: in the XX.YY section of the XX.YY release branch,
+ but in the trunk section of the trunk branch.)
+
+ This usually happens when the PR is written for a given branch
+ first, and then cherry-picked in an older maintenance branch, but
+ the cherry-picker forgets to move the Change entry in the first
+ branch.
+
+ Fix: ensure that the entry is in the same section on all branches,
+ by putting it in the "smallest" version -- assuming that all bigger
+ versions also contain this change.
+
+- A change entry is present in a given section, but the change is not
+ present in the corresponding release branch.
+
+ There are two common causes for this with radically different solutions:
+
+ + If a PR is merged a long time after they were submitted, the merge
+ may put their Changes entry in the section of an older release,
+ while it should go in trunk.
+
+ Fix: in trunk, move the entry to the trunk section.
+
+ + Sometimes the author of a PR against trunk intends it to be
+ cherry-picked in an older release branch, and places it in the
+ corresponding Changes entry, but we forget to cherry-pick.
+
+ Fix: cherry-pick the PR in the appropriate branch.
+
+ Reading the PR discussion is often enough to distinguish between the
+ two cases, but one should be careful before cherry-picking in
+ a branch (for an active release branch, check with the release
+ manager(s)).
+
+Figuring out the status of a given Changes entry often requires
+checking the git log for trunk and branches. Grepping for the PR
+number often suffices (note: when you cherry-pick a PR in a release
+branch, please target the merge commit to ensure the PR number is
+present in the log), or parts of the commit message text.
+
+### Ensure each entry is in the appropriate section
+
+(of course)
+
+### Fill more details in unclear Changes entries
+
+Expert users want to learn about the changes in the new release. We
+want to avoid forcing them to read the tortuous PR discussion, by
+giving enough details in the Changes entry.
+
+In particular, for language changes, showing a small example of
+concrete syntax of the new feature is very useful, and giving a few
+words of explanations helps.
+
+Compare for example
+
+ - #8820: quoted string extensions
+ (Gabriel Radanne, Leo White and Gabriel Scherer,
+ request by Bikal Lem)
+
+with
+
+ - #8820: quoted extensions: {%foo|...|} is lighter syntax for
+ [%foo {||}], and {%foo bar|...|bar} for [%foo {bar|...|bar}].
+ (Gabriel Radanne, Leo White and Gabriel Scherer,
+ request by Bikal Lem)
+
+This is also important for changes that break compatibility; users
+will scrutinize them with more care, so please give clear information on
+what breaks and, possibly, recommended update methods.
+
+Having enough details is also useful when you will grep the Changes
+later to know when a given change was introduced (knowing what to grep
+can be difficult).
+
+### Ordering of Changes entries
+
+In the past, we would order Changes entries numerically (this would
+also correspond to a chronological order). Since 4.09 Gabriel is
+trying to order them by importance (being an exciting/notable feature
+for a large number of users). What is the best ordering of sections,
+and the best entry ordering within a section, to put the most
+important changes first? This is guesswork of course, and we commonly
+have a long tail of "not so important PRs" in each section which don't
+need to be ordered with respect to each other -- one may break two
+lines just before this long tail.
+
+The ordering of sections depends on the nature of the changes within
+the release; some releases have an exciting "Runtime" section, many
+release don't. Usually "Language features" is among the first, and
+"Bug fixes" is the very last (who cares about bugs, right?).
+
+If some entries feel very anecdotal, consider moving them to the Bug
+Fixes section.
+
+### Extract release highlights to News
+
+From time to time, synchronize the `News` file with the release highlights
+of each version.
--- /dev/null
+#!/bin/sh
+
+#**************************************************************************
+#* *
+#* OCaml *
+#* *
+#* Gabriel Scherer, projet Parsifal, INRIA Saclay *
+#* *
+#* Copyright 2018 Institut National de Recherche en Informatique et *
+#* en Automatique. *
+#* *
+#* All rights reserved. This file is distributed under the terms of *
+#* the GNU Lesser General Public License version 2.1, with the *
+#* special exception on linking described in the file LICENSE. *
+#* *
+#**************************************************************************
+
+# This script performs a series of transformation on its argument to
+# turn ASCII references into Markdown-format links:
+# - #NNNN links to Github
+# - (Changes#VERSION) link to the Changes file
+# Breaking change list bullet are converted into annotations
+
+# It was only tested with GNU sed. Sorry!
+
+GITHUB=https://github.com/ocaml/ocaml
+
+sed "s,(Changes#\(.*\)),[Changes file for \\1]($GITHUB/blob/\\1/Changes),g" $1 \
+| sed "s,#\([0-9]\+\),[#\\1]($GITHUB/issues/\\1),g" \
+| sed "s/^*/* [*breaking change*]/g"
--- /dev/null
+## Announcing a beta version:
+
+
+```
+Dear OCaml users,
+
+The release of OCaml $MAJOR.$MINOR.$BUGFIX is approaching. We have created
+a beta version to help you adapt your software to the new features
+ahead of the release.
+
+The source code is available at these addresses:
+
+ https://github.com/ocaml/ocaml/archive/$VERSION.tar.gz
+ https://caml.inria.fr/pub/distrib/ocaml-$BRANCH/ocaml-$VERSION.tar.gz
+
+The compiler can also be installed as an OPAM switch with one of the
+following commands:
+
+opam update
+opam switch create ocaml-variants.$VERSION --repositories=default,beta=git+https://github.com/ocaml/ocaml-beta-repository.git
+
+or
+
+opam update
+opam switch create ocaml-variants.$VERSION+<VARIANT> --repositories=default,beta=git+https://github.com/ocaml/ocaml-beta-repository.git
+
+ where you replace <VARIANT> with one of these:
+ afl
+ flambda
+ fp
+ fp+flambda
+
+We want to know about all bugs. Please report them here:
+ https://github.com/ocaml/ocaml/issues
+
+Happy hacking,
+
+-- $HUMAN for the OCaml team.
+```
--- /dev/null
+## Announcing a production release:
+
+```
+Dear OCaml users,
+
+We have the pleasure of celebrating <event> by announcing the release of
+OCaml version $VERSION.
+This is mainly a bug-fix release, see the list of changes below.
+
+It is (or soon will be) available as a set of OPAM switches,
+and as a source download here:
+ https://caml.inria.fr/pub/distrib/ocaml-$BRANCH/
+
+Happy hacking,
+
+-- $HUMAN for the OCaml team.
+
+<< insert the relevant Changes section >>
+```
--- /dev/null
+
+## Announcing a release candidate:
+
+```
+Dear OCaml users,
+
+The release of OCaml version $MAJOR.$MINOR.$BUGFIX is imminent. We have
+created a release candidate that you can test.
+
+The source code is available at these addresses:
+
+ https://github.com/ocaml/ocaml/archive/$VERSION.tar.gz
+ https://caml.inria.fr/pub/distrib/ocaml-$BRANCH/ocaml-$VERSION.tar.gz
+
+The compiler can also be installed as an OPAM switch with one of the
+following commands:
+
+opam update
+opam switch create ocaml-variants.$VERSION --repositories=default,beta=git+https://github.com/ocaml/ocaml-beta-repository.git
+
+or
+
+opam update
+opam switch create ocaml-variants.$VERSION+<VARIANT> --repositories=default,beta=git+https://github.com/ocaml/ocaml-beta-repository.git
+
+ where you replace <VARIANT> with one of these:
+ afl
+ flambda
+ fp
+ fp+flambda
+
+We want to know about all bugs. Please report them here:
+ https://github.com/ocaml/ocaml/issues
+
+Happy hacking,
+
+-- $HUMAN for the OCaml team.
+
+<< insert the relevant Changes section >>
+```
+++ /dev/null
-interp_b.$(O): interp.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/backtrace.h caml/exec.h caml/callback.h caml/debugger.h caml/fail.h \
- caml/fix_code.h caml/instrtrace.h caml/instruct.h caml/interp.h \
- caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
- caml/mlvalues.h caml/prims.h caml/signals.h caml/stacks.h caml/memory.h \
- caml/startup_aux.h caml/jumptbl.h
-misc_b.$(O): misc.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
- caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/osdeps.h caml/memory.h \
- caml/version.h
-stacks_b.$(O): stacks.c caml/config.h caml/m.h caml/s.h caml/fail.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
- caml/domain_state.tbl caml/misc.h caml/mlvalues.h caml/stacks.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h
-fix_code_b.$(O): fix_code.c caml/config.h caml/m.h caml/s.h caml/codefrag.h \
- caml/debugger.h caml/misc.h caml/config.h caml/mlvalues.h \
- caml/domain_state.h caml/domain_state.tbl caml/fix_code.h \
- caml/instruct.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h caml/reverse.h
-startup_aux_b.$(O): startup_aux.c caml/backtrace.h caml/mlvalues.h \
- caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/exec.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/callback.h caml/major_gc.h caml/dynlink.h \
- caml/osdeps.h caml/memory.h caml/startup_aux.h caml/memprof.h \
- caml/roots.h
-startup_byt_b.$(O): startup_byt.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
- caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/callback.h \
- caml/custom.h caml/debugger.h caml/domain.h caml/dynlink.h \
- caml/eventlog.h caml/exec.h caml/fail.h caml/fix_code.h caml/freelist.h \
- caml/gc_ctrl.h caml/instrtrace.h caml/interp.h caml/intext.h caml/io.h \
- caml/io.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h caml/prims.h \
- caml/printexc.h caml/reverse.h caml/signals.h caml/stacks.h caml/sys.h \
- caml/startup.h caml/startup_aux.h caml/version.h
-freelist_b.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/custom.h \
- caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/freelist.h caml/gc.h caml/gc_ctrl.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/major_gc.h caml/misc.h \
- caml/mlvalues.h caml/eventlog.h
-major_gc_b.$(O): major_gc.c caml/compact.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/custom.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/freelist.h caml/gc.h \
- caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
- caml/signals.h caml/weak.h caml/memprof.h caml/eventlog.h
-minor_gc_b.$(O): minor_gc.c caml/custom.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/config.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/gc.h caml/gc_ctrl.h \
- caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \
- caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h caml/memprof.h \
- caml/eventlog.h
-memory_b.$(O): memory.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/config.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
- caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/signals.h caml/memprof.h caml/roots.h \
- caml/memory.h caml/eventlog.h
-alloc_b.$(O): alloc.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
- caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
- caml/stacks.h caml/memory.h caml/signals.h
-roots_byt_b.$(O): roots_byt.c caml/finalise.h caml/roots.h caml/misc.h \
- caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/globroots.h caml/major_gc.h caml/memory.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h caml/memprof.h \
- caml/eventlog.h
-globroots_b.$(O): globroots.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
- caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/globroots.h \
- caml/roots.h caml/skiplist.h
-fail_byt_b.$(O): fail_byt.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/callback.h caml/fail.h caml/gc.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h caml/printexc.h caml/signals.h \
- caml/stacks.h caml/memory.h
-signals_b.$(O): signals.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/callback.h caml/config.h caml/fail.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h caml/roots.h caml/memory.h \
- caml/signals.h caml/signals_machdep.h caml/sys.h caml/memprof.h \
- caml/roots.h caml/finalise.h
-signals_byt_b.$(O): signals_byt.c caml/config.h caml/m.h caml/s.h \
- caml/memory.h caml/config.h caml/gc.h caml/mlvalues.h caml/misc.h \
- caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/fail.h caml/finalise.h caml/roots.h caml/memory.h caml/osdeps.h \
- caml/signals.h caml/signals_machdep.h
-printexc_b.$(O): printexc.c caml/backtrace.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/exec.h caml/callback.h caml/debugger.h caml/fail.h caml/misc.h \
- caml/mlvalues.h caml/printexc.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/memprof.h caml/roots.h caml/memory.h
-backtrace_byt_b.$(O): backtrace_byt.c caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
- caml/mlvalues.h caml/domain_state.tbl caml/alloc.h caml/custom.h \
- caml/io.h caml/instruct.h caml/intext.h caml/io.h caml/exec.h \
- caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/startup.h \
- caml/exec.h caml/stacks.h caml/memory.h caml/sys.h caml/backtrace.h \
- caml/fail.h caml/backtrace_prim.h caml/backtrace.h caml/debugger.h
-backtrace_b.$(O): backtrace.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/backtrace.h caml/exec.h \
- caml/backtrace_prim.h caml/backtrace.h caml/fail.h caml/debugger.h
-compare_b.$(O): compare.c caml/custom.h caml/mlvalues.h caml/config.h caml/m.h \
- caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
- caml/mlvalues.h
-ints_b.$(O): ints.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
- caml/fail.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h
-eventlog_b.$(O): eventlog.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/eventlog.h caml/misc.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/osdeps.h caml/memory.h
-floats_b.$(O): floats.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
- caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
-str_b.$(O): str.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/mlvalues.h caml/misc.h
-array_b.$(O): array.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
- caml/signals.h caml/eventlog.h caml/spacetime.h caml/io.h caml/stack.h
-io_b.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/custom.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
- caml/signals.h caml/sys.h
-extern_b.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/codefrag.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \
- caml/intext.h caml/io.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h caml/reverse.h
-intern_b.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/callback.h caml/codefrag.h caml/config.h caml/custom.h caml/fail.h \
- caml/gc.h caml/intext.h caml/io.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/memprof.h caml/roots.h caml/memory.h caml/mlvalues.h \
- caml/misc.h caml/reverse.h caml/signals.h
-hash_b.$(O): hash.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
- caml/custom.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/hash.h
-sys_b.$(O): sys.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/debugger.h caml/fail.h caml/gc_ctrl.h caml/io.h caml/misc.h \
- caml/mlvalues.h caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/signals.h caml/stacks.h caml/sys.h caml/version.h caml/callback.h \
- caml/startup_aux.h
-meta_b.$(O): meta.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/codefrag.h \
- caml/config.h caml/debugger.h caml/fail.h caml/fix_code.h caml/interp.h \
- caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \
- caml/signals.h caml/stacks.h caml/memory.h
-parsing_b.$(O): parsing.c caml/config.h caml/m.h caml/s.h caml/mlvalues.h \
- caml/config.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
- caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/alloc.h
-gc_ctrl_b.$(O): gc_ctrl.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/backtrace.h caml/exec.h caml/compact.h caml/custom.h caml/fail.h \
- caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/memory.h \
- caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h \
- caml/eventlog.h caml/stacks.h caml/startup_aux.h
-md5_b.$(O): md5.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/mlvalues.h caml/io.h caml/reverse.h
-obj_b.$(O): obj.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \
- caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
-lexing_b.$(O): lexing.c caml/fail.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h
-callback_b.$(O): callback.c caml/callback.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/domain.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/mlvalues.h caml/interp.h caml/instruct.h caml/fix_code.h \
- caml/stacks.h caml/memory.h
-debugger_b.$(O): debugger.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/codefrag.h caml/config.h caml/debugger.h caml/misc.h caml/osdeps.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/skiplist.h caml/fail.h \
- caml/fix_code.h caml/instruct.h caml/intext.h caml/io.h caml/io.h \
- caml/mlvalues.h caml/stacks.h caml/sys.h
-weak_b.$(O): weak.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
- caml/weak.h caml/memory.h caml/minor_gc.h caml/signals.h caml/eventlog.h
-compact_b.$(O): compact.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/config.h caml/finalise.h caml/roots.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \
- caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h caml/compact.h \
- caml/memprof.h caml/eventlog.h
-finalise_b.$(O): finalise.c caml/callback.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/compact.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/minor_gc.h caml/mlvalues.h \
- caml/roots.h caml/signals.h
-custom_b.$(O): custom.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/custom.h caml/fail.h caml/gc_ctrl.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/mlvalues.h caml/signals.h
-dynlink_b.$(O): dynlink.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
- caml/domain_state.tbl caml/dynlink.h caml/fail.h caml/mlvalues.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
- caml/memory.h caml/prims.h caml/signals.h
-spacetime_byt_b.$(O): spacetime_byt.c caml/fail.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
- caml/domain_state.tbl caml/mlvalues.h
-afl_b.$(O): afl.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
- caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
- caml/domain_state.tbl caml/osdeps.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h
-unix_b.$(O): unix.c caml/config.h caml/m.h caml/s.h caml/fail.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
- caml/memory.h caml/signals.h caml/sys.h caml/io.h caml/alloc.h
-bigarray_b.$(O): bigarray.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/bigarray.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
- caml/hash.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
- caml/signals.h
-main_b.$(O): main.c caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
- caml/domain_state.tbl caml/sys.h caml/osdeps.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h
-memprof_b.$(O): memprof.c caml/memprof.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/fail.h \
- caml/alloc.h caml/callback.h caml/signals.h caml/memory.h \
- caml/minor_gc.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
- caml/weak.h caml/stack.h caml/misc.h caml/compact.h caml/printexc.h \
- caml/eventlog.h
-domain_b.$(O): domain.c caml/domain_state.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h
-skiplist_b.$(O): skiplist.c caml/config.h caml/m.h caml/s.h caml/memory.h \
- caml/config.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/misc.h caml/skiplist.h
-codefrag_b.$(O): codefrag.c caml/codefrag.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/md5.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/skiplist.h
-win32_b.$(O): win32.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/address_class.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/osdeps.h caml/memory.h caml/signals.h \
- caml/sys.h caml/config.h
-instrtrace_b.$(O): instrtrace.c
-interp_bd.$(O): interp.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/backtrace.h caml/exec.h caml/callback.h caml/debugger.h caml/fail.h \
- caml/fix_code.h caml/instrtrace.h caml/instruct.h caml/interp.h \
- caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
- caml/mlvalues.h caml/prims.h caml/signals.h caml/stacks.h caml/memory.h \
- caml/startup_aux.h
-misc_bd.$(O): misc.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
- caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/osdeps.h caml/memory.h \
- caml/version.h
-stacks_bd.$(O): stacks.c caml/config.h caml/m.h caml/s.h caml/fail.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
- caml/domain_state.tbl caml/misc.h caml/mlvalues.h caml/stacks.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h
-fix_code_bd.$(O): fix_code.c caml/config.h caml/m.h caml/s.h caml/codefrag.h \
- caml/debugger.h caml/misc.h caml/config.h caml/mlvalues.h \
- caml/domain_state.h caml/domain_state.tbl caml/fix_code.h \
- caml/instruct.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h caml/reverse.h
-startup_aux_bd.$(O): startup_aux.c caml/backtrace.h caml/mlvalues.h \
- caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/exec.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/callback.h caml/major_gc.h caml/dynlink.h \
- caml/osdeps.h caml/memory.h caml/startup_aux.h caml/memprof.h \
- caml/roots.h
-startup_byt_bd.$(O): startup_byt.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
- caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/callback.h \
- caml/custom.h caml/debugger.h caml/domain.h caml/dynlink.h \
- caml/eventlog.h caml/exec.h caml/fail.h caml/fix_code.h caml/freelist.h \
- caml/gc_ctrl.h caml/instrtrace.h caml/interp.h caml/intext.h caml/io.h \
- caml/io.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h caml/prims.h \
- caml/printexc.h caml/reverse.h caml/signals.h caml/stacks.h caml/sys.h \
- caml/startup.h caml/startup_aux.h caml/version.h
-freelist_bd.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/custom.h \
- caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/freelist.h caml/gc.h caml/gc_ctrl.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/major_gc.h caml/misc.h \
- caml/mlvalues.h caml/eventlog.h
-major_gc_bd.$(O): major_gc.c caml/compact.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/custom.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/freelist.h caml/gc.h \
- caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
- caml/signals.h caml/weak.h caml/memprof.h caml/eventlog.h
-minor_gc_bd.$(O): minor_gc.c caml/custom.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/config.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/gc.h caml/gc_ctrl.h \
- caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \
- caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h caml/memprof.h \
- caml/eventlog.h
-memory_bd.$(O): memory.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/config.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
- caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/signals.h caml/memprof.h caml/roots.h \
- caml/memory.h caml/eventlog.h
-alloc_bd.$(O): alloc.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
- caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
- caml/stacks.h caml/memory.h caml/signals.h
-roots_byt_bd.$(O): roots_byt.c caml/finalise.h caml/roots.h caml/misc.h \
- caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/globroots.h caml/major_gc.h caml/memory.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h caml/memprof.h \
- caml/eventlog.h
-globroots_bd.$(O): globroots.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
- caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/globroots.h \
- caml/roots.h caml/skiplist.h
-fail_byt_bd.$(O): fail_byt.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/callback.h caml/fail.h caml/gc.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h caml/printexc.h caml/signals.h \
- caml/stacks.h caml/memory.h
-signals_bd.$(O): signals.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/callback.h caml/config.h caml/fail.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h caml/roots.h caml/memory.h \
- caml/signals.h caml/signals_machdep.h caml/sys.h caml/memprof.h \
- caml/roots.h caml/finalise.h
-signals_byt_bd.$(O): signals_byt.c caml/config.h caml/m.h caml/s.h \
- caml/memory.h caml/config.h caml/gc.h caml/mlvalues.h caml/misc.h \
- caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/fail.h caml/finalise.h caml/roots.h caml/memory.h caml/osdeps.h \
- caml/signals.h caml/signals_machdep.h
-printexc_bd.$(O): printexc.c caml/backtrace.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/exec.h caml/callback.h caml/debugger.h caml/fail.h caml/misc.h \
- caml/mlvalues.h caml/printexc.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/memprof.h caml/roots.h caml/memory.h
-backtrace_byt_bd.$(O): backtrace_byt.c caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
- caml/mlvalues.h caml/domain_state.tbl caml/alloc.h caml/custom.h \
- caml/io.h caml/instruct.h caml/intext.h caml/io.h caml/exec.h \
- caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/startup.h \
- caml/exec.h caml/stacks.h caml/memory.h caml/sys.h caml/backtrace.h \
- caml/fail.h caml/backtrace_prim.h caml/backtrace.h caml/debugger.h
-backtrace_bd.$(O): backtrace.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/backtrace.h caml/exec.h \
- caml/backtrace_prim.h caml/backtrace.h caml/fail.h caml/debugger.h
-compare_bd.$(O): compare.c caml/custom.h caml/mlvalues.h caml/config.h caml/m.h \
- caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
- caml/mlvalues.h
-ints_bd.$(O): ints.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
- caml/fail.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h
-eventlog_bd.$(O): eventlog.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/eventlog.h caml/misc.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/osdeps.h caml/memory.h
-floats_bd.$(O): floats.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
- caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
-str_bd.$(O): str.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/mlvalues.h caml/misc.h
-array_bd.$(O): array.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
- caml/signals.h caml/eventlog.h caml/spacetime.h caml/io.h caml/stack.h
-io_bd.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/custom.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
- caml/signals.h caml/sys.h
-extern_bd.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/codefrag.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \
- caml/intext.h caml/io.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h caml/reverse.h
-intern_bd.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/callback.h caml/codefrag.h caml/config.h caml/custom.h caml/fail.h \
- caml/gc.h caml/intext.h caml/io.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/memprof.h caml/roots.h caml/memory.h caml/mlvalues.h \
- caml/misc.h caml/reverse.h caml/signals.h
-hash_bd.$(O): hash.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
- caml/custom.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/hash.h
-sys_bd.$(O): sys.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/debugger.h caml/fail.h caml/gc_ctrl.h caml/io.h caml/misc.h \
- caml/mlvalues.h caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/signals.h caml/stacks.h caml/sys.h caml/version.h caml/callback.h \
- caml/startup_aux.h
-meta_bd.$(O): meta.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/codefrag.h \
- caml/config.h caml/debugger.h caml/fail.h caml/fix_code.h caml/interp.h \
- caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \
- caml/signals.h caml/stacks.h caml/memory.h
-parsing_bd.$(O): parsing.c caml/config.h caml/m.h caml/s.h caml/mlvalues.h \
- caml/config.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
- caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/alloc.h
-gc_ctrl_bd.$(O): gc_ctrl.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/backtrace.h caml/exec.h caml/compact.h caml/custom.h caml/fail.h \
- caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/memory.h \
- caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h \
- caml/eventlog.h caml/stacks.h caml/startup_aux.h
-md5_bd.$(O): md5.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/mlvalues.h caml/io.h caml/reverse.h
-obj_bd.$(O): obj.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \
- caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
-lexing_bd.$(O): lexing.c caml/fail.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h
-callback_bd.$(O): callback.c caml/callback.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/domain.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/mlvalues.h caml/interp.h caml/instruct.h caml/fix_code.h \
- caml/stacks.h caml/memory.h
-debugger_bd.$(O): debugger.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/codefrag.h caml/config.h caml/debugger.h caml/misc.h caml/osdeps.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/skiplist.h caml/fail.h \
- caml/fix_code.h caml/instruct.h caml/intext.h caml/io.h caml/io.h \
- caml/mlvalues.h caml/stacks.h caml/sys.h
-weak_bd.$(O): weak.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
- caml/weak.h caml/memory.h caml/minor_gc.h caml/signals.h caml/eventlog.h
-compact_bd.$(O): compact.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/config.h caml/finalise.h caml/roots.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \
- caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h caml/compact.h \
- caml/memprof.h caml/eventlog.h
-finalise_bd.$(O): finalise.c caml/callback.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/compact.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/minor_gc.h caml/mlvalues.h \
- caml/roots.h caml/signals.h
-custom_bd.$(O): custom.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/custom.h caml/fail.h caml/gc_ctrl.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/mlvalues.h caml/signals.h
-dynlink_bd.$(O): dynlink.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
- caml/domain_state.tbl caml/dynlink.h caml/fail.h caml/mlvalues.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
- caml/memory.h caml/prims.h caml/signals.h
-spacetime_byt_bd.$(O): spacetime_byt.c caml/fail.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
- caml/domain_state.tbl caml/mlvalues.h
-afl_bd.$(O): afl.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
- caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
- caml/domain_state.tbl caml/osdeps.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h
-unix_bd.$(O): unix.c caml/config.h caml/m.h caml/s.h caml/fail.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
- caml/memory.h caml/signals.h caml/sys.h caml/io.h caml/alloc.h
-bigarray_bd.$(O): bigarray.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/bigarray.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
- caml/hash.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
- caml/signals.h
-main_bd.$(O): main.c caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
- caml/domain_state.tbl caml/sys.h caml/osdeps.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h
-memprof_bd.$(O): memprof.c caml/memprof.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/fail.h \
- caml/alloc.h caml/callback.h caml/signals.h caml/memory.h \
- caml/minor_gc.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
- caml/weak.h caml/stack.h caml/misc.h caml/compact.h caml/printexc.h \
- caml/eventlog.h
-domain_bd.$(O): domain.c caml/domain_state.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h
-skiplist_bd.$(O): skiplist.c caml/config.h caml/m.h caml/s.h caml/memory.h \
- caml/config.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/misc.h caml/skiplist.h
-codefrag_bd.$(O): codefrag.c caml/codefrag.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/md5.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/skiplist.h
-win32_bd.$(O): win32.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/address_class.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/osdeps.h caml/memory.h caml/signals.h \
- caml/sys.h caml/config.h
-instrtrace_bd.$(O): instrtrace.c caml/instrtrace.h caml/mlvalues.h \
- caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/instruct.h caml/misc.h caml/mlvalues.h \
- caml/opnames.h caml/prims.h caml/stacks.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/startup_aux.h
-interp_bi.$(O): interp.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/backtrace.h caml/exec.h caml/callback.h caml/debugger.h caml/fail.h \
- caml/fix_code.h caml/instrtrace.h caml/instruct.h caml/interp.h \
- caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
- caml/mlvalues.h caml/prims.h caml/signals.h caml/stacks.h caml/memory.h \
- caml/startup_aux.h caml/jumptbl.h
-misc_bi.$(O): misc.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
- caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/osdeps.h caml/memory.h \
- caml/version.h
-stacks_bi.$(O): stacks.c caml/config.h caml/m.h caml/s.h caml/fail.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
- caml/domain_state.tbl caml/misc.h caml/mlvalues.h caml/stacks.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h
-fix_code_bi.$(O): fix_code.c caml/config.h caml/m.h caml/s.h caml/codefrag.h \
- caml/debugger.h caml/misc.h caml/config.h caml/mlvalues.h \
- caml/domain_state.h caml/domain_state.tbl caml/fix_code.h \
- caml/instruct.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h caml/reverse.h
-startup_aux_bi.$(O): startup_aux.c caml/backtrace.h caml/mlvalues.h \
- caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/exec.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/callback.h caml/major_gc.h caml/dynlink.h \
- caml/osdeps.h caml/memory.h caml/startup_aux.h caml/memprof.h \
- caml/roots.h
-startup_byt_bi.$(O): startup_byt.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
- caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/callback.h \
- caml/custom.h caml/debugger.h caml/domain.h caml/dynlink.h \
- caml/eventlog.h caml/exec.h caml/fail.h caml/fix_code.h caml/freelist.h \
- caml/gc_ctrl.h caml/instrtrace.h caml/interp.h caml/intext.h caml/io.h \
- caml/io.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h caml/prims.h \
- caml/printexc.h caml/reverse.h caml/signals.h caml/stacks.h caml/sys.h \
- caml/startup.h caml/startup_aux.h caml/version.h
-freelist_bi.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/custom.h \
- caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/freelist.h caml/gc.h caml/gc_ctrl.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/major_gc.h caml/misc.h \
- caml/mlvalues.h caml/eventlog.h
-major_gc_bi.$(O): major_gc.c caml/compact.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/custom.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/freelist.h caml/gc.h \
- caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
- caml/signals.h caml/weak.h caml/memprof.h caml/eventlog.h
-minor_gc_bi.$(O): minor_gc.c caml/custom.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/config.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/gc.h caml/gc_ctrl.h \
- caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \
- caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h caml/memprof.h \
- caml/eventlog.h
-memory_bi.$(O): memory.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/config.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
- caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/signals.h caml/memprof.h caml/roots.h \
- caml/memory.h caml/eventlog.h
-alloc_bi.$(O): alloc.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
- caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
- caml/stacks.h caml/memory.h caml/signals.h
-roots_byt_bi.$(O): roots_byt.c caml/finalise.h caml/roots.h caml/misc.h \
- caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/globroots.h caml/major_gc.h caml/memory.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h caml/memprof.h \
- caml/eventlog.h
-globroots_bi.$(O): globroots.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
- caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/globroots.h \
- caml/roots.h caml/skiplist.h
-fail_byt_bi.$(O): fail_byt.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/callback.h caml/fail.h caml/gc.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h caml/printexc.h caml/signals.h \
- caml/stacks.h caml/memory.h
-signals_bi.$(O): signals.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/callback.h caml/config.h caml/fail.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h caml/roots.h caml/memory.h \
- caml/signals.h caml/signals_machdep.h caml/sys.h caml/memprof.h \
- caml/roots.h caml/finalise.h
-signals_byt_bi.$(O): signals_byt.c caml/config.h caml/m.h caml/s.h \
- caml/memory.h caml/config.h caml/gc.h caml/mlvalues.h caml/misc.h \
- caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/fail.h caml/finalise.h caml/roots.h caml/memory.h caml/osdeps.h \
- caml/signals.h caml/signals_machdep.h
-printexc_bi.$(O): printexc.c caml/backtrace.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/exec.h caml/callback.h caml/debugger.h caml/fail.h caml/misc.h \
- caml/mlvalues.h caml/printexc.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/memprof.h caml/roots.h caml/memory.h
-backtrace_byt_bi.$(O): backtrace_byt.c caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
- caml/mlvalues.h caml/domain_state.tbl caml/alloc.h caml/custom.h \
- caml/io.h caml/instruct.h caml/intext.h caml/io.h caml/exec.h \
- caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/startup.h \
- caml/exec.h caml/stacks.h caml/memory.h caml/sys.h caml/backtrace.h \
- caml/fail.h caml/backtrace_prim.h caml/backtrace.h caml/debugger.h
-backtrace_bi.$(O): backtrace.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/backtrace.h caml/exec.h \
- caml/backtrace_prim.h caml/backtrace.h caml/fail.h caml/debugger.h
-compare_bi.$(O): compare.c caml/custom.h caml/mlvalues.h caml/config.h caml/m.h \
- caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
- caml/mlvalues.h
-ints_bi.$(O): ints.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
- caml/fail.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h
-eventlog_bi.$(O): eventlog.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/eventlog.h caml/misc.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/osdeps.h caml/memory.h
-floats_bi.$(O): floats.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
- caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
-str_bi.$(O): str.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/mlvalues.h caml/misc.h
-array_bi.$(O): array.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
- caml/signals.h caml/eventlog.h caml/spacetime.h caml/io.h caml/stack.h
-io_bi.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/custom.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
- caml/signals.h caml/sys.h
-extern_bi.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/codefrag.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \
- caml/intext.h caml/io.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h caml/reverse.h
-intern_bi.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/callback.h caml/codefrag.h caml/config.h caml/custom.h caml/fail.h \
- caml/gc.h caml/intext.h caml/io.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/memprof.h caml/roots.h caml/memory.h caml/mlvalues.h \
- caml/misc.h caml/reverse.h caml/signals.h
-hash_bi.$(O): hash.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
- caml/custom.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/hash.h
-sys_bi.$(O): sys.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/debugger.h caml/fail.h caml/gc_ctrl.h caml/io.h caml/misc.h \
- caml/mlvalues.h caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/signals.h caml/stacks.h caml/sys.h caml/version.h caml/callback.h \
- caml/startup_aux.h
-meta_bi.$(O): meta.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/codefrag.h \
- caml/config.h caml/debugger.h caml/fail.h caml/fix_code.h caml/interp.h \
- caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \
- caml/signals.h caml/stacks.h caml/memory.h
-parsing_bi.$(O): parsing.c caml/config.h caml/m.h caml/s.h caml/mlvalues.h \
- caml/config.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
- caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/alloc.h
-gc_ctrl_bi.$(O): gc_ctrl.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/backtrace.h caml/exec.h caml/compact.h caml/custom.h caml/fail.h \
- caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/memory.h \
- caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h \
- caml/eventlog.h caml/stacks.h caml/startup_aux.h
-md5_bi.$(O): md5.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/mlvalues.h caml/io.h caml/reverse.h
-obj_bi.$(O): obj.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \
- caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
-lexing_bi.$(O): lexing.c caml/fail.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h
-callback_bi.$(O): callback.c caml/callback.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/domain.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/mlvalues.h caml/interp.h caml/instruct.h caml/fix_code.h \
- caml/stacks.h caml/memory.h
-debugger_bi.$(O): debugger.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/codefrag.h caml/config.h caml/debugger.h caml/misc.h caml/osdeps.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/skiplist.h caml/fail.h \
- caml/fix_code.h caml/instruct.h caml/intext.h caml/io.h caml/io.h \
- caml/mlvalues.h caml/stacks.h caml/sys.h
-weak_bi.$(O): weak.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
- caml/weak.h caml/memory.h caml/minor_gc.h caml/signals.h caml/eventlog.h
-compact_bi.$(O): compact.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/config.h caml/finalise.h caml/roots.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \
- caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h caml/compact.h \
- caml/memprof.h caml/eventlog.h
-finalise_bi.$(O): finalise.c caml/callback.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/compact.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/minor_gc.h caml/mlvalues.h \
- caml/roots.h caml/signals.h
-custom_bi.$(O): custom.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/custom.h caml/fail.h caml/gc_ctrl.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/mlvalues.h caml/signals.h
-dynlink_bi.$(O): dynlink.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
- caml/domain_state.tbl caml/dynlink.h caml/fail.h caml/mlvalues.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
- caml/memory.h caml/prims.h caml/signals.h
-spacetime_byt_bi.$(O): spacetime_byt.c caml/fail.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
- caml/domain_state.tbl caml/mlvalues.h
-afl_bi.$(O): afl.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
- caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
- caml/domain_state.tbl caml/osdeps.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h
-unix_bi.$(O): unix.c caml/config.h caml/m.h caml/s.h caml/fail.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
- caml/memory.h caml/signals.h caml/sys.h caml/io.h caml/alloc.h
-bigarray_bi.$(O): bigarray.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/bigarray.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
- caml/hash.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
- caml/signals.h
-main_bi.$(O): main.c caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
- caml/domain_state.tbl caml/sys.h caml/osdeps.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h
-memprof_bi.$(O): memprof.c caml/memprof.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/fail.h \
- caml/alloc.h caml/callback.h caml/signals.h caml/memory.h \
- caml/minor_gc.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
- caml/weak.h caml/stack.h caml/misc.h caml/compact.h caml/printexc.h \
- caml/eventlog.h
-domain_bi.$(O): domain.c caml/domain_state.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h
-skiplist_bi.$(O): skiplist.c caml/config.h caml/m.h caml/s.h caml/memory.h \
- caml/config.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/misc.h caml/skiplist.h
-codefrag_bi.$(O): codefrag.c caml/codefrag.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/md5.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/skiplist.h
-win32_bi.$(O): win32.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/address_class.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/osdeps.h caml/memory.h caml/signals.h \
- caml/sys.h caml/config.h
-instrtrace_bi.$(O): instrtrace.c
-interp_bpic.$(O): interp.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/backtrace.h caml/exec.h caml/callback.h caml/debugger.h caml/fail.h \
- caml/fix_code.h caml/instrtrace.h caml/instruct.h caml/interp.h \
- caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
- caml/mlvalues.h caml/prims.h caml/signals.h caml/stacks.h caml/memory.h \
- caml/startup_aux.h caml/jumptbl.h
-misc_bpic.$(O): misc.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
- caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/osdeps.h caml/memory.h \
- caml/version.h
-stacks_bpic.$(O): stacks.c caml/config.h caml/m.h caml/s.h caml/fail.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
- caml/domain_state.tbl caml/misc.h caml/mlvalues.h caml/stacks.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h
-fix_code_bpic.$(O): fix_code.c caml/config.h caml/m.h caml/s.h caml/codefrag.h \
- caml/debugger.h caml/misc.h caml/config.h caml/mlvalues.h \
- caml/domain_state.h caml/domain_state.tbl caml/fix_code.h \
- caml/instruct.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h caml/reverse.h
-startup_aux_bpic.$(O): startup_aux.c caml/backtrace.h caml/mlvalues.h \
- caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/exec.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/callback.h caml/major_gc.h caml/dynlink.h \
- caml/osdeps.h caml/memory.h caml/startup_aux.h caml/memprof.h \
- caml/roots.h
-startup_byt_bpic.$(O): startup_byt.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
- caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/callback.h \
- caml/custom.h caml/debugger.h caml/domain.h caml/dynlink.h \
- caml/eventlog.h caml/exec.h caml/fail.h caml/fix_code.h caml/freelist.h \
- caml/gc_ctrl.h caml/instrtrace.h caml/interp.h caml/intext.h caml/io.h \
- caml/io.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h caml/prims.h \
- caml/printexc.h caml/reverse.h caml/signals.h caml/stacks.h caml/sys.h \
- caml/startup.h caml/startup_aux.h caml/version.h
-freelist_bpic.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/custom.h \
- caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/freelist.h caml/gc.h caml/gc_ctrl.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/major_gc.h caml/misc.h \
- caml/mlvalues.h caml/eventlog.h
-major_gc_bpic.$(O): major_gc.c caml/compact.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/custom.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/freelist.h caml/gc.h \
- caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
- caml/signals.h caml/weak.h caml/memprof.h caml/eventlog.h
-minor_gc_bpic.$(O): minor_gc.c caml/custom.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/config.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/gc.h caml/gc_ctrl.h \
- caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \
- caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h caml/memprof.h \
- caml/eventlog.h
-memory_bpic.$(O): memory.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/config.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
- caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/signals.h caml/memprof.h caml/roots.h \
- caml/memory.h caml/eventlog.h
-alloc_bpic.$(O): alloc.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
- caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
- caml/stacks.h caml/memory.h caml/signals.h
-roots_byt_bpic.$(O): roots_byt.c caml/finalise.h caml/roots.h caml/misc.h \
- caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/globroots.h caml/major_gc.h caml/memory.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h caml/memprof.h \
- caml/eventlog.h
-globroots_bpic.$(O): globroots.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
- caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/globroots.h \
- caml/roots.h caml/skiplist.h
-fail_byt_bpic.$(O): fail_byt.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/callback.h caml/fail.h caml/gc.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h caml/printexc.h caml/signals.h \
- caml/stacks.h caml/memory.h
-signals_bpic.$(O): signals.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/callback.h caml/config.h caml/fail.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h caml/roots.h caml/memory.h \
- caml/signals.h caml/signals_machdep.h caml/sys.h caml/memprof.h \
- caml/roots.h caml/finalise.h
-signals_byt_bpic.$(O): signals_byt.c caml/config.h caml/m.h caml/s.h \
- caml/memory.h caml/config.h caml/gc.h caml/mlvalues.h caml/misc.h \
- caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/fail.h caml/finalise.h caml/roots.h caml/memory.h caml/osdeps.h \
- caml/signals.h caml/signals_machdep.h
-printexc_bpic.$(O): printexc.c caml/backtrace.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/exec.h caml/callback.h caml/debugger.h caml/fail.h caml/misc.h \
- caml/mlvalues.h caml/printexc.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/memprof.h caml/roots.h caml/memory.h
-backtrace_byt_bpic.$(O): backtrace_byt.c caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
- caml/mlvalues.h caml/domain_state.tbl caml/alloc.h caml/custom.h \
- caml/io.h caml/instruct.h caml/intext.h caml/io.h caml/exec.h \
- caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/startup.h \
- caml/exec.h caml/stacks.h caml/memory.h caml/sys.h caml/backtrace.h \
- caml/fail.h caml/backtrace_prim.h caml/backtrace.h caml/debugger.h
-backtrace_bpic.$(O): backtrace.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/backtrace.h caml/exec.h \
- caml/backtrace_prim.h caml/backtrace.h caml/fail.h caml/debugger.h
-compare_bpic.$(O): compare.c caml/custom.h caml/mlvalues.h caml/config.h caml/m.h \
- caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
- caml/mlvalues.h
-ints_bpic.$(O): ints.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
- caml/fail.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h
-eventlog_bpic.$(O): eventlog.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/eventlog.h caml/misc.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/osdeps.h caml/memory.h
-floats_bpic.$(O): floats.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
- caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
-str_bpic.$(O): str.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/mlvalues.h caml/misc.h
-array_bpic.$(O): array.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
- caml/signals.h caml/eventlog.h caml/spacetime.h caml/io.h caml/stack.h
-io_bpic.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/custom.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
- caml/signals.h caml/sys.h
-extern_bpic.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/codefrag.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \
- caml/intext.h caml/io.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h caml/reverse.h
-intern_bpic.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/callback.h caml/codefrag.h caml/config.h caml/custom.h caml/fail.h \
- caml/gc.h caml/intext.h caml/io.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/memprof.h caml/roots.h caml/memory.h caml/mlvalues.h \
- caml/misc.h caml/reverse.h caml/signals.h
-hash_bpic.$(O): hash.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
- caml/custom.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/hash.h
-sys_bpic.$(O): sys.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/debugger.h caml/fail.h caml/gc_ctrl.h caml/io.h caml/misc.h \
- caml/mlvalues.h caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/signals.h caml/stacks.h caml/sys.h caml/version.h caml/callback.h \
- caml/startup_aux.h
-meta_bpic.$(O): meta.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/codefrag.h \
- caml/config.h caml/debugger.h caml/fail.h caml/fix_code.h caml/interp.h \
- caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \
- caml/signals.h caml/stacks.h caml/memory.h
-parsing_bpic.$(O): parsing.c caml/config.h caml/m.h caml/s.h caml/mlvalues.h \
- caml/config.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
- caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/alloc.h
-gc_ctrl_bpic.$(O): gc_ctrl.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/backtrace.h caml/exec.h caml/compact.h caml/custom.h caml/fail.h \
- caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/memory.h \
- caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h \
- caml/eventlog.h caml/stacks.h caml/startup_aux.h
-md5_bpic.$(O): md5.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/mlvalues.h caml/io.h caml/reverse.h
-obj_bpic.$(O): obj.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \
- caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
-lexing_bpic.$(O): lexing.c caml/fail.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h
-callback_bpic.$(O): callback.c caml/callback.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/domain.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/mlvalues.h caml/interp.h caml/instruct.h caml/fix_code.h \
- caml/stacks.h caml/memory.h
-debugger_bpic.$(O): debugger.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/codefrag.h caml/config.h caml/debugger.h caml/misc.h caml/osdeps.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/skiplist.h caml/fail.h \
- caml/fix_code.h caml/instruct.h caml/intext.h caml/io.h caml/io.h \
- caml/mlvalues.h caml/stacks.h caml/sys.h
-weak_bpic.$(O): weak.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
- caml/weak.h caml/memory.h caml/minor_gc.h caml/signals.h caml/eventlog.h
-compact_bpic.$(O): compact.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/config.h caml/finalise.h caml/roots.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \
- caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h caml/compact.h \
- caml/memprof.h caml/eventlog.h
-finalise_bpic.$(O): finalise.c caml/callback.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/compact.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/minor_gc.h caml/mlvalues.h \
- caml/roots.h caml/signals.h
-custom_bpic.$(O): custom.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/custom.h caml/fail.h caml/gc_ctrl.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/mlvalues.h caml/signals.h
-dynlink_bpic.$(O): dynlink.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
- caml/domain_state.tbl caml/dynlink.h caml/fail.h caml/mlvalues.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
- caml/memory.h caml/prims.h caml/signals.h
-spacetime_byt_bpic.$(O): spacetime_byt.c caml/fail.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
- caml/domain_state.tbl caml/mlvalues.h
-afl_bpic.$(O): afl.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
- caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
- caml/domain_state.tbl caml/osdeps.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h
-unix_bpic.$(O): unix.c caml/config.h caml/m.h caml/s.h caml/fail.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
- caml/memory.h caml/signals.h caml/sys.h caml/io.h caml/alloc.h
-bigarray_bpic.$(O): bigarray.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/bigarray.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
- caml/hash.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
- caml/signals.h
-main_bpic.$(O): main.c caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
- caml/domain_state.tbl caml/sys.h caml/osdeps.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h
-memprof_bpic.$(O): memprof.c caml/memprof.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/fail.h \
- caml/alloc.h caml/callback.h caml/signals.h caml/memory.h \
- caml/minor_gc.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
- caml/weak.h caml/stack.h caml/misc.h caml/compact.h caml/printexc.h \
- caml/eventlog.h
-domain_bpic.$(O): domain.c caml/domain_state.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h
-skiplist_bpic.$(O): skiplist.c caml/config.h caml/m.h caml/s.h caml/memory.h \
- caml/config.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/misc.h caml/skiplist.h
-codefrag_bpic.$(O): codefrag.c caml/codefrag.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/md5.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/skiplist.h
-win32_bpic.$(O): win32.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/address_class.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/osdeps.h caml/memory.h caml/signals.h \
- caml/sys.h caml/config.h
-instrtrace_bpic.$(O): instrtrace.c
-startup_aux_n.$(O): startup_aux.c caml/backtrace.h caml/mlvalues.h \
- caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/exec.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/callback.h caml/major_gc.h caml/osdeps.h \
- caml/memory.h caml/startup_aux.h caml/memprof.h caml/roots.h
-startup_nat_n.$(O): startup_nat.c caml/callback.h caml/mlvalues.h \
- caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/custom.h \
- caml/codefrag.h caml/debugger.h caml/domain.h caml/eventlog.h \
- caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/intext.h \
- caml/io.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
- caml/mlvalues.h caml/osdeps.h caml/memory.h caml/printexc.h caml/stack.h \
- caml/startup_aux.h caml/sys.h
-main_n.$(O): main.c caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
- caml/domain_state.tbl caml/sys.h caml/osdeps.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h
-fail_nat_n.$(O): fail_nat.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/domain.h caml/fail.h caml/io.h caml/gc.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/mlvalues.h caml/printexc.h caml/signals.h \
- caml/stack.h caml/roots.h caml/memory.h caml/callback.h
-roots_nat_n.$(O): roots_nat.c caml/finalise.h caml/roots.h caml/misc.h \
- caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/globroots.h caml/memory.h caml/major_gc.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h caml/memprof.h \
- caml/eventlog.h
-signals_n.$(O): signals.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/callback.h caml/config.h caml/fail.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h caml/roots.h caml/memory.h \
- caml/signals.h caml/signals_machdep.h caml/sys.h caml/memprof.h \
- caml/roots.h caml/finalise.h
-signals_nat_n.$(O): signals_nat.c caml/fail.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
- caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h \
- signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h \
- caml/memprof.h caml/roots.h caml/finalise.h
-misc_n.$(O): misc.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
- caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/osdeps.h caml/memory.h \
- caml/version.h
-freelist_n.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/custom.h \
- caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/freelist.h caml/gc.h caml/gc_ctrl.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/major_gc.h caml/misc.h \
- caml/mlvalues.h caml/eventlog.h
-major_gc_n.$(O): major_gc.c caml/compact.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/custom.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/freelist.h caml/gc.h \
- caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
- caml/signals.h caml/weak.h caml/memprof.h caml/eventlog.h
-minor_gc_n.$(O): minor_gc.c caml/custom.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/config.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/gc.h caml/gc_ctrl.h \
- caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \
- caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h caml/memprof.h \
- caml/eventlog.h
-memory_n.$(O): memory.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/config.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
- caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/signals.h caml/memprof.h caml/roots.h \
- caml/memory.h caml/eventlog.h
-alloc_n.$(O): alloc.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
- caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
- caml/stacks.h caml/memory.h caml/signals.h
-compare_n.$(O): compare.c caml/custom.h caml/mlvalues.h caml/config.h caml/m.h \
- caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
- caml/mlvalues.h
-ints_n.$(O): ints.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
- caml/fail.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h
-floats_n.$(O): floats.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
- caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
-str_n.$(O): str.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/mlvalues.h caml/misc.h
-array_n.$(O): array.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
- caml/signals.h caml/eventlog.h caml/spacetime.h caml/io.h caml/stack.h
-io_n.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/custom.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
- caml/signals.h caml/sys.h
-extern_n.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/codefrag.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \
- caml/intext.h caml/io.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h caml/reverse.h
-intern_n.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/callback.h caml/codefrag.h caml/config.h caml/custom.h caml/fail.h \
- caml/gc.h caml/intext.h caml/io.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/memprof.h caml/roots.h caml/memory.h caml/mlvalues.h \
- caml/misc.h caml/reverse.h caml/signals.h
-hash_n.$(O): hash.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
- caml/custom.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/hash.h
-sys_n.$(O): sys.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/debugger.h caml/fail.h caml/gc_ctrl.h caml/io.h caml/misc.h \
- caml/mlvalues.h caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/signals.h caml/stacks.h caml/sys.h caml/version.h caml/callback.h \
- caml/startup_aux.h
-parsing_n.$(O): parsing.c caml/config.h caml/m.h caml/s.h caml/mlvalues.h \
- caml/config.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
- caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/alloc.h
-gc_ctrl_n.$(O): gc_ctrl.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/backtrace.h caml/exec.h caml/compact.h caml/custom.h caml/fail.h \
- caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/memory.h \
- caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h \
- caml/eventlog.h caml/stack.h caml/startup_aux.h
-eventlog_n.$(O): eventlog.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/eventlog.h caml/misc.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/osdeps.h caml/memory.h
-md5_n.$(O): md5.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/mlvalues.h caml/io.h caml/reverse.h
-obj_n.$(O): obj.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \
- caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
-lexing_n.$(O): lexing.c caml/fail.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h
-unix_n.$(O): unix.c caml/config.h caml/m.h caml/s.h caml/fail.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
- caml/memory.h caml/signals.h caml/sys.h caml/io.h caml/alloc.h
-printexc_n.$(O): printexc.c caml/backtrace.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/exec.h caml/callback.h caml/debugger.h caml/fail.h caml/misc.h \
- caml/mlvalues.h caml/printexc.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/memprof.h caml/roots.h caml/memory.h
-callback_n.$(O): callback.c caml/callback.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/domain.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/mlvalues.h
-weak_n.$(O): weak.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
- caml/weak.h caml/memory.h caml/minor_gc.h caml/signals.h caml/eventlog.h
-compact_n.$(O): compact.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/config.h caml/finalise.h caml/roots.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \
- caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h caml/compact.h \
- caml/memprof.h caml/eventlog.h
-finalise_n.$(O): finalise.c caml/callback.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/compact.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/minor_gc.h caml/mlvalues.h \
- caml/roots.h caml/signals.h
-custom_n.$(O): custom.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/custom.h caml/fail.h caml/gc_ctrl.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/mlvalues.h caml/signals.h
-globroots_n.$(O): globroots.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
- caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/globroots.h \
- caml/roots.h caml/skiplist.h
-backtrace_nat_n.$(O): backtrace_nat.c caml/alloc.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
- caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/backtrace_prim.h \
- caml/backtrace.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
- caml/mlvalues.h caml/stack.h
-backtrace_n.$(O): backtrace.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/backtrace.h caml/exec.h \
- caml/backtrace_prim.h caml/backtrace.h caml/fail.h caml/debugger.h
-dynlink_nat_n.$(O): dynlink_nat.c caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
- caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/stack.h caml/callback.h caml/codefrag.h caml/alloc.h caml/intext.h \
- caml/io.h caml/osdeps.h caml/memory.h caml/fail.h caml/signals.h \
- caml/hooks.h
-debugger_n.$(O): debugger.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/codefrag.h caml/config.h caml/debugger.h caml/misc.h caml/osdeps.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/skiplist.h
-meta_n.$(O): meta.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/codefrag.h \
- caml/config.h caml/debugger.h caml/fail.h caml/fix_code.h caml/interp.h \
- caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \
- caml/signals.h caml/stacks.h caml/memory.h
-dynlink_n.$(O): dynlink.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
- caml/domain_state.tbl caml/dynlink.h caml/fail.h caml/mlvalues.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
- caml/memory.h caml/prims.h caml/signals.h
-clambda_checks_n.$(O): clambda_checks.c caml/mlvalues.h caml/config.h caml/m.h \
- caml/s.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
- caml/domain_state.tbl
-spacetime_nat_n.$(O): spacetime_nat.c caml/config.h caml/m.h caml/s.h \
- caml/alloc.h caml/misc.h caml/config.h caml/mlvalues.h \
- caml/domain_state.h caml/domain_state.tbl caml/backtrace_prim.h \
- caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h caml/intext.h \
- caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
- caml/roots.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \
- caml/stack.h
-spacetime_snapshot_n.$(O): spacetime_snapshot.c caml/alloc.h caml/misc.h \
- caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
- caml/domain_state.tbl caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
- caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/gc_ctrl.h \
- caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
- caml/memory.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \
- caml/stack.h
-afl_n.$(O): afl.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
- caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
- caml/domain_state.tbl caml/osdeps.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h
-bigarray_n.$(O): bigarray.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/bigarray.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
- caml/hash.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
- caml/signals.h
-memprof_n.$(O): memprof.c caml/memprof.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/fail.h \
- caml/alloc.h caml/callback.h caml/signals.h caml/memory.h \
- caml/minor_gc.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
- caml/weak.h caml/stack.h caml/misc.h caml/compact.h caml/printexc.h \
- caml/eventlog.h
-domain_n.$(O): domain.c caml/domain_state.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h
-skiplist_n.$(O): skiplist.c caml/config.h caml/m.h caml/s.h caml/memory.h \
- caml/config.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/misc.h caml/skiplist.h
-codefrag_n.$(O): codefrag.c caml/codefrag.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/md5.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/skiplist.h
-win32_n.$(O): win32.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/address_class.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/osdeps.h caml/memory.h caml/signals.h \
- caml/sys.h caml/config.h
-startup_aux_nd.$(O): startup_aux.c caml/backtrace.h caml/mlvalues.h \
- caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/exec.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/callback.h caml/major_gc.h caml/osdeps.h \
- caml/memory.h caml/startup_aux.h caml/memprof.h caml/roots.h
-startup_nat_nd.$(O): startup_nat.c caml/callback.h caml/mlvalues.h \
- caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/custom.h \
- caml/codefrag.h caml/debugger.h caml/domain.h caml/eventlog.h \
- caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/intext.h \
- caml/io.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
- caml/mlvalues.h caml/osdeps.h caml/memory.h caml/printexc.h caml/stack.h \
- caml/startup_aux.h caml/sys.h
-main_nd.$(O): main.c caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
- caml/domain_state.tbl caml/sys.h caml/osdeps.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h
-fail_nat_nd.$(O): fail_nat.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/domain.h caml/fail.h caml/io.h caml/gc.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/mlvalues.h caml/printexc.h caml/signals.h \
- caml/stack.h caml/roots.h caml/memory.h caml/callback.h
-roots_nat_nd.$(O): roots_nat.c caml/finalise.h caml/roots.h caml/misc.h \
- caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/globroots.h caml/memory.h caml/major_gc.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h caml/memprof.h \
- caml/eventlog.h
-signals_nd.$(O): signals.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/callback.h caml/config.h caml/fail.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h caml/roots.h caml/memory.h \
- caml/signals.h caml/signals_machdep.h caml/sys.h caml/memprof.h \
- caml/roots.h caml/finalise.h
-signals_nat_nd.$(O): signals_nat.c caml/fail.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
- caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h \
- signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h \
- caml/memprof.h caml/roots.h caml/finalise.h
-misc_nd.$(O): misc.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
- caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/osdeps.h caml/memory.h \
- caml/version.h
-freelist_nd.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/custom.h \
- caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/freelist.h caml/gc.h caml/gc_ctrl.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/major_gc.h caml/misc.h \
- caml/mlvalues.h caml/eventlog.h
-major_gc_nd.$(O): major_gc.c caml/compact.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/custom.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/freelist.h caml/gc.h \
- caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
- caml/signals.h caml/weak.h caml/memprof.h caml/eventlog.h
-minor_gc_nd.$(O): minor_gc.c caml/custom.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/config.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/gc.h caml/gc_ctrl.h \
- caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \
- caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h caml/memprof.h \
- caml/eventlog.h
-memory_nd.$(O): memory.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/config.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
- caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/signals.h caml/memprof.h caml/roots.h \
- caml/memory.h caml/eventlog.h
-alloc_nd.$(O): alloc.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
- caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
- caml/stacks.h caml/memory.h caml/signals.h
-compare_nd.$(O): compare.c caml/custom.h caml/mlvalues.h caml/config.h caml/m.h \
- caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
- caml/mlvalues.h
-ints_nd.$(O): ints.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
- caml/fail.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h
-floats_nd.$(O): floats.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
- caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
-str_nd.$(O): str.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/mlvalues.h caml/misc.h
-array_nd.$(O): array.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
- caml/signals.h caml/eventlog.h caml/spacetime.h caml/io.h caml/stack.h
-io_nd.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/custom.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
- caml/signals.h caml/sys.h
-extern_nd.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/codefrag.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \
- caml/intext.h caml/io.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h caml/reverse.h
-intern_nd.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/callback.h caml/codefrag.h caml/config.h caml/custom.h caml/fail.h \
- caml/gc.h caml/intext.h caml/io.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/memprof.h caml/roots.h caml/memory.h caml/mlvalues.h \
- caml/misc.h caml/reverse.h caml/signals.h
-hash_nd.$(O): hash.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
- caml/custom.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/hash.h
-sys_nd.$(O): sys.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/debugger.h caml/fail.h caml/gc_ctrl.h caml/io.h caml/misc.h \
- caml/mlvalues.h caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/signals.h caml/stacks.h caml/sys.h caml/version.h caml/callback.h \
- caml/startup_aux.h
-parsing_nd.$(O): parsing.c caml/config.h caml/m.h caml/s.h caml/mlvalues.h \
- caml/config.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
- caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/alloc.h
-gc_ctrl_nd.$(O): gc_ctrl.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/backtrace.h caml/exec.h caml/compact.h caml/custom.h caml/fail.h \
- caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/memory.h \
- caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h \
- caml/eventlog.h caml/stack.h caml/startup_aux.h
-eventlog_nd.$(O): eventlog.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/eventlog.h caml/misc.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/osdeps.h caml/memory.h
-md5_nd.$(O): md5.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/mlvalues.h caml/io.h caml/reverse.h
-obj_nd.$(O): obj.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \
- caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
-lexing_nd.$(O): lexing.c caml/fail.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h
-unix_nd.$(O): unix.c caml/config.h caml/m.h caml/s.h caml/fail.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
- caml/memory.h caml/signals.h caml/sys.h caml/io.h caml/alloc.h
-printexc_nd.$(O): printexc.c caml/backtrace.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/exec.h caml/callback.h caml/debugger.h caml/fail.h caml/misc.h \
- caml/mlvalues.h caml/printexc.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/memprof.h caml/roots.h caml/memory.h
-callback_nd.$(O): callback.c caml/callback.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/domain.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/mlvalues.h
-weak_nd.$(O): weak.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
- caml/weak.h caml/memory.h caml/minor_gc.h caml/signals.h caml/eventlog.h
-compact_nd.$(O): compact.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/config.h caml/finalise.h caml/roots.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \
- caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h caml/compact.h \
- caml/memprof.h caml/eventlog.h
-finalise_nd.$(O): finalise.c caml/callback.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/compact.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/minor_gc.h caml/mlvalues.h \
- caml/roots.h caml/signals.h
-custom_nd.$(O): custom.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/custom.h caml/fail.h caml/gc_ctrl.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/mlvalues.h caml/signals.h
-globroots_nd.$(O): globroots.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
- caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/globroots.h \
- caml/roots.h caml/skiplist.h
-backtrace_nat_nd.$(O): backtrace_nat.c caml/alloc.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
- caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/backtrace_prim.h \
- caml/backtrace.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
- caml/mlvalues.h caml/stack.h
-backtrace_nd.$(O): backtrace.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/backtrace.h caml/exec.h \
- caml/backtrace_prim.h caml/backtrace.h caml/fail.h caml/debugger.h
-dynlink_nat_nd.$(O): dynlink_nat.c caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
- caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/stack.h caml/callback.h caml/codefrag.h caml/alloc.h caml/intext.h \
- caml/io.h caml/osdeps.h caml/memory.h caml/fail.h caml/signals.h \
- caml/hooks.h
-debugger_nd.$(O): debugger.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/codefrag.h caml/config.h caml/debugger.h caml/misc.h caml/osdeps.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/skiplist.h
-meta_nd.$(O): meta.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/codefrag.h \
- caml/config.h caml/debugger.h caml/fail.h caml/fix_code.h caml/interp.h \
- caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \
- caml/signals.h caml/stacks.h caml/memory.h
-dynlink_nd.$(O): dynlink.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
- caml/domain_state.tbl caml/dynlink.h caml/fail.h caml/mlvalues.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
- caml/memory.h caml/prims.h caml/signals.h
-clambda_checks_nd.$(O): clambda_checks.c caml/mlvalues.h caml/config.h caml/m.h \
- caml/s.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
- caml/domain_state.tbl
-spacetime_nat_nd.$(O): spacetime_nat.c caml/config.h caml/m.h caml/s.h \
- caml/alloc.h caml/misc.h caml/config.h caml/mlvalues.h \
- caml/domain_state.h caml/domain_state.tbl caml/backtrace_prim.h \
- caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h caml/intext.h \
- caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
- caml/roots.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \
- caml/stack.h
-spacetime_snapshot_nd.$(O): spacetime_snapshot.c caml/alloc.h caml/misc.h \
- caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
- caml/domain_state.tbl caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
- caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/gc_ctrl.h \
- caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
- caml/memory.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \
- caml/stack.h
-afl_nd.$(O): afl.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
- caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
- caml/domain_state.tbl caml/osdeps.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h
-bigarray_nd.$(O): bigarray.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/bigarray.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
- caml/hash.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
- caml/signals.h
-memprof_nd.$(O): memprof.c caml/memprof.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/fail.h \
- caml/alloc.h caml/callback.h caml/signals.h caml/memory.h \
- caml/minor_gc.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
- caml/weak.h caml/stack.h caml/misc.h caml/compact.h caml/printexc.h \
- caml/eventlog.h
-domain_nd.$(O): domain.c caml/domain_state.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h
-skiplist_nd.$(O): skiplist.c caml/config.h caml/m.h caml/s.h caml/memory.h \
- caml/config.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/misc.h caml/skiplist.h
-codefrag_nd.$(O): codefrag.c caml/codefrag.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/md5.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/skiplist.h
-win32_nd.$(O): win32.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/address_class.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/osdeps.h caml/memory.h caml/signals.h \
- caml/sys.h caml/config.h
-startup_aux_ni.$(O): startup_aux.c caml/backtrace.h caml/mlvalues.h \
- caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/exec.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/callback.h caml/major_gc.h caml/osdeps.h \
- caml/memory.h caml/startup_aux.h caml/memprof.h caml/roots.h
-startup_nat_ni.$(O): startup_nat.c caml/callback.h caml/mlvalues.h \
- caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/custom.h \
- caml/codefrag.h caml/debugger.h caml/domain.h caml/eventlog.h \
- caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/intext.h \
- caml/io.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
- caml/mlvalues.h caml/osdeps.h caml/memory.h caml/printexc.h caml/stack.h \
- caml/startup_aux.h caml/sys.h
-main_ni.$(O): main.c caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
- caml/domain_state.tbl caml/sys.h caml/osdeps.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h
-fail_nat_ni.$(O): fail_nat.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/domain.h caml/fail.h caml/io.h caml/gc.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/mlvalues.h caml/printexc.h caml/signals.h \
- caml/stack.h caml/roots.h caml/memory.h caml/callback.h
-roots_nat_ni.$(O): roots_nat.c caml/finalise.h caml/roots.h caml/misc.h \
- caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/globroots.h caml/memory.h caml/major_gc.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h caml/memprof.h \
- caml/eventlog.h
-signals_ni.$(O): signals.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/callback.h caml/config.h caml/fail.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h caml/roots.h caml/memory.h \
- caml/signals.h caml/signals_machdep.h caml/sys.h caml/memprof.h \
- caml/roots.h caml/finalise.h
-signals_nat_ni.$(O): signals_nat.c caml/fail.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
- caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h \
- signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h \
- caml/memprof.h caml/roots.h caml/finalise.h
-misc_ni.$(O): misc.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
- caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/osdeps.h caml/memory.h \
- caml/version.h
-freelist_ni.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/custom.h \
- caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/freelist.h caml/gc.h caml/gc_ctrl.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/major_gc.h caml/misc.h \
- caml/mlvalues.h caml/eventlog.h
-major_gc_ni.$(O): major_gc.c caml/compact.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/custom.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/freelist.h caml/gc.h \
- caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
- caml/signals.h caml/weak.h caml/memprof.h caml/eventlog.h
-minor_gc_ni.$(O): minor_gc.c caml/custom.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/config.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/gc.h caml/gc_ctrl.h \
- caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \
- caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h caml/memprof.h \
- caml/eventlog.h
-memory_ni.$(O): memory.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/config.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
- caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/signals.h caml/memprof.h caml/roots.h \
- caml/memory.h caml/eventlog.h
-alloc_ni.$(O): alloc.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
- caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
- caml/stacks.h caml/memory.h caml/signals.h
-compare_ni.$(O): compare.c caml/custom.h caml/mlvalues.h caml/config.h caml/m.h \
- caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
- caml/mlvalues.h
-ints_ni.$(O): ints.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
- caml/fail.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h
-floats_ni.$(O): floats.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
- caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
-str_ni.$(O): str.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/mlvalues.h caml/misc.h
-array_ni.$(O): array.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
- caml/signals.h caml/eventlog.h caml/spacetime.h caml/io.h caml/stack.h
-io_ni.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/custom.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
- caml/signals.h caml/sys.h
-extern_ni.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/codefrag.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \
- caml/intext.h caml/io.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h caml/reverse.h
-intern_ni.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/callback.h caml/codefrag.h caml/config.h caml/custom.h caml/fail.h \
- caml/gc.h caml/intext.h caml/io.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/memprof.h caml/roots.h caml/memory.h caml/mlvalues.h \
- caml/misc.h caml/reverse.h caml/signals.h
-hash_ni.$(O): hash.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
- caml/custom.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/hash.h
-sys_ni.$(O): sys.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/debugger.h caml/fail.h caml/gc_ctrl.h caml/io.h caml/misc.h \
- caml/mlvalues.h caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/signals.h caml/stacks.h caml/sys.h caml/version.h caml/callback.h \
- caml/startup_aux.h
-parsing_ni.$(O): parsing.c caml/config.h caml/m.h caml/s.h caml/mlvalues.h \
- caml/config.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
- caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/alloc.h
-gc_ctrl_ni.$(O): gc_ctrl.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/backtrace.h caml/exec.h caml/compact.h caml/custom.h caml/fail.h \
- caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/memory.h \
- caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h \
- caml/eventlog.h caml/stack.h caml/startup_aux.h
-eventlog_ni.$(O): eventlog.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/eventlog.h caml/misc.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/osdeps.h caml/memory.h
-md5_ni.$(O): md5.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/mlvalues.h caml/io.h caml/reverse.h
-obj_ni.$(O): obj.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \
- caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
-lexing_ni.$(O): lexing.c caml/fail.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h
-unix_ni.$(O): unix.c caml/config.h caml/m.h caml/s.h caml/fail.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
- caml/memory.h caml/signals.h caml/sys.h caml/io.h caml/alloc.h
-printexc_ni.$(O): printexc.c caml/backtrace.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/exec.h caml/callback.h caml/debugger.h caml/fail.h caml/misc.h \
- caml/mlvalues.h caml/printexc.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/memprof.h caml/roots.h caml/memory.h
-callback_ni.$(O): callback.c caml/callback.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/domain.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/mlvalues.h
-weak_ni.$(O): weak.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
- caml/weak.h caml/memory.h caml/minor_gc.h caml/signals.h caml/eventlog.h
-compact_ni.$(O): compact.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/config.h caml/finalise.h caml/roots.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \
- caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h caml/compact.h \
- caml/memprof.h caml/eventlog.h
-finalise_ni.$(O): finalise.c caml/callback.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/compact.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/minor_gc.h caml/mlvalues.h \
- caml/roots.h caml/signals.h
-custom_ni.$(O): custom.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/custom.h caml/fail.h caml/gc_ctrl.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/mlvalues.h caml/signals.h
-globroots_ni.$(O): globroots.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
- caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/globroots.h \
- caml/roots.h caml/skiplist.h
-backtrace_nat_ni.$(O): backtrace_nat.c caml/alloc.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
- caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/backtrace_prim.h \
- caml/backtrace.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
- caml/mlvalues.h caml/stack.h
-backtrace_ni.$(O): backtrace.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/backtrace.h caml/exec.h \
- caml/backtrace_prim.h caml/backtrace.h caml/fail.h caml/debugger.h
-dynlink_nat_ni.$(O): dynlink_nat.c caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
- caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/stack.h caml/callback.h caml/codefrag.h caml/alloc.h caml/intext.h \
- caml/io.h caml/osdeps.h caml/memory.h caml/fail.h caml/signals.h \
- caml/hooks.h
-debugger_ni.$(O): debugger.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/codefrag.h caml/config.h caml/debugger.h caml/misc.h caml/osdeps.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/skiplist.h
-meta_ni.$(O): meta.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/codefrag.h \
- caml/config.h caml/debugger.h caml/fail.h caml/fix_code.h caml/interp.h \
- caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \
- caml/signals.h caml/stacks.h caml/memory.h
-dynlink_ni.$(O): dynlink.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
- caml/domain_state.tbl caml/dynlink.h caml/fail.h caml/mlvalues.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
- caml/memory.h caml/prims.h caml/signals.h
-clambda_checks_ni.$(O): clambda_checks.c caml/mlvalues.h caml/config.h caml/m.h \
- caml/s.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
- caml/domain_state.tbl
-spacetime_nat_ni.$(O): spacetime_nat.c caml/config.h caml/m.h caml/s.h \
- caml/alloc.h caml/misc.h caml/config.h caml/mlvalues.h \
- caml/domain_state.h caml/domain_state.tbl caml/backtrace_prim.h \
- caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h caml/intext.h \
- caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
- caml/roots.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \
- caml/stack.h
-spacetime_snapshot_ni.$(O): spacetime_snapshot.c caml/alloc.h caml/misc.h \
- caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
- caml/domain_state.tbl caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
- caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/gc_ctrl.h \
- caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
- caml/memory.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \
- caml/stack.h
-afl_ni.$(O): afl.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
- caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
- caml/domain_state.tbl caml/osdeps.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h
-bigarray_ni.$(O): bigarray.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/bigarray.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
- caml/hash.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
- caml/signals.h
-memprof_ni.$(O): memprof.c caml/memprof.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/fail.h \
- caml/alloc.h caml/callback.h caml/signals.h caml/memory.h \
- caml/minor_gc.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
- caml/weak.h caml/stack.h caml/misc.h caml/compact.h caml/printexc.h \
- caml/eventlog.h
-domain_ni.$(O): domain.c caml/domain_state.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h
-skiplist_ni.$(O): skiplist.c caml/config.h caml/m.h caml/s.h caml/memory.h \
- caml/config.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/misc.h caml/skiplist.h
-codefrag_ni.$(O): codefrag.c caml/codefrag.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/md5.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/skiplist.h
-win32_ni.$(O): win32.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/address_class.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/osdeps.h caml/memory.h caml/signals.h \
- caml/sys.h caml/config.h
-startup_aux_npic.$(O): startup_aux.c caml/backtrace.h caml/mlvalues.h \
- caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/exec.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/callback.h caml/major_gc.h caml/osdeps.h \
- caml/memory.h caml/startup_aux.h caml/memprof.h caml/roots.h
-startup_nat_npic.$(O): startup_nat.c caml/callback.h caml/mlvalues.h \
- caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/custom.h \
- caml/codefrag.h caml/debugger.h caml/domain.h caml/eventlog.h \
- caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/intext.h \
- caml/io.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
- caml/mlvalues.h caml/osdeps.h caml/memory.h caml/printexc.h caml/stack.h \
- caml/startup_aux.h caml/sys.h
-main_npic.$(O): main.c caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
- caml/domain_state.tbl caml/sys.h caml/osdeps.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h
-fail_nat_npic.$(O): fail_nat.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/domain.h caml/fail.h caml/io.h caml/gc.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/mlvalues.h caml/printexc.h caml/signals.h \
- caml/stack.h caml/roots.h caml/memory.h caml/callback.h
-roots_nat_npic.$(O): roots_nat.c caml/finalise.h caml/roots.h caml/misc.h \
- caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
- caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/globroots.h caml/memory.h caml/major_gc.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h caml/memprof.h \
- caml/eventlog.h
-signals_npic.$(O): signals.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/callback.h caml/config.h caml/fail.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h caml/roots.h caml/memory.h \
- caml/signals.h caml/signals_machdep.h caml/sys.h caml/memprof.h \
- caml/roots.h caml/finalise.h
-signals_nat_npic.$(O): signals_nat.c caml/fail.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
- caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h \
- signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h \
- caml/memprof.h caml/roots.h caml/finalise.h
-misc_npic.$(O): misc.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
- caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/osdeps.h caml/memory.h \
- caml/version.h
-freelist_npic.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/custom.h \
- caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/freelist.h caml/gc.h caml/gc_ctrl.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/major_gc.h caml/misc.h \
- caml/mlvalues.h caml/eventlog.h
-major_gc_npic.$(O): major_gc.c caml/compact.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/custom.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/freelist.h caml/gc.h \
- caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
- caml/signals.h caml/weak.h caml/memprof.h caml/eventlog.h
-minor_gc_npic.$(O): minor_gc.c caml/custom.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/config.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/gc.h caml/gc_ctrl.h \
- caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \
- caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h caml/memprof.h \
- caml/eventlog.h
-memory_npic.$(O): memory.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/config.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
- caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \
- caml/misc.h caml/mlvalues.h caml/signals.h caml/memprof.h caml/roots.h \
- caml/memory.h caml/eventlog.h
-alloc_npic.$(O): alloc.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
- caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
- caml/stacks.h caml/memory.h caml/signals.h
-compare_npic.$(O): compare.c caml/custom.h caml/mlvalues.h caml/config.h caml/m.h \
- caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
- caml/mlvalues.h
-ints_npic.$(O): ints.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \
- caml/fail.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h
-floats_npic.$(O): floats.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
- caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
-str_npic.$(O): str.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/mlvalues.h caml/misc.h
-array_npic.$(O): array.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \
- caml/signals.h caml/eventlog.h caml/spacetime.h caml/io.h caml/stack.h
-io_npic.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/custom.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
- caml/signals.h caml/sys.h
-extern_npic.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/codefrag.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \
- caml/intext.h caml/io.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/mlvalues.h caml/reverse.h
-intern_npic.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/callback.h caml/codefrag.h caml/config.h caml/custom.h caml/fail.h \
- caml/gc.h caml/intext.h caml/io.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/memprof.h caml/roots.h caml/memory.h caml/mlvalues.h \
- caml/misc.h caml/reverse.h caml/signals.h
-hash_npic.$(O): hash.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
- caml/custom.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/hash.h
-sys_npic.$(O): sys.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/debugger.h caml/fail.h caml/gc_ctrl.h caml/io.h caml/misc.h \
- caml/mlvalues.h caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/signals.h caml/stacks.h caml/sys.h caml/version.h caml/callback.h \
- caml/startup_aux.h
-parsing_npic.$(O): parsing.c caml/config.h caml/m.h caml/s.h caml/mlvalues.h \
- caml/config.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
- caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/alloc.h
-gc_ctrl_npic.$(O): gc_ctrl.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/backtrace.h caml/exec.h caml/compact.h caml/custom.h caml/fail.h \
- caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/memory.h \
- caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h \
- caml/eventlog.h caml/stack.h caml/startup_aux.h
-eventlog_npic.$(O): eventlog.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/eventlog.h caml/misc.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/osdeps.h caml/memory.h
-md5_npic.$(O): md5.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/mlvalues.h caml/io.h caml/reverse.h
-obj_npic.$(O): obj.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \
- caml/signals.h caml/spacetime.h caml/io.h caml/stack.h
-lexing_npic.$(O): lexing.c caml/fail.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h
-unix_npic.$(O): unix.c caml/config.h caml/m.h caml/s.h caml/fail.h caml/misc.h \
- caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
- caml/memory.h caml/signals.h caml/sys.h caml/io.h caml/alloc.h
-printexc_npic.$(O): printexc.c caml/backtrace.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/exec.h caml/callback.h caml/debugger.h caml/fail.h caml/misc.h \
- caml/mlvalues.h caml/printexc.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/memprof.h caml/roots.h caml/memory.h
-callback_npic.$(O): callback.c caml/callback.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/domain.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/mlvalues.h
-weak_npic.$(O): weak.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \
- caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
- caml/weak.h caml/memory.h caml/minor_gc.h caml/signals.h caml/eventlog.h
-compact_npic.$(O): compact.c caml/address_class.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/config.h caml/finalise.h caml/roots.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \
- caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h caml/compact.h \
- caml/memprof.h caml/eventlog.h
-finalise_npic.$(O): finalise.c caml/callback.h caml/mlvalues.h caml/config.h \
- caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/compact.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/minor_gc.h caml/mlvalues.h \
- caml/roots.h caml/signals.h
-custom_npic.$(O): custom.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/custom.h caml/fail.h caml/gc_ctrl.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/mlvalues.h caml/signals.h
-globroots_npic.$(O): globroots.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \
- caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \
- caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/globroots.h \
- caml/roots.h caml/skiplist.h
-backtrace_nat_npic.$(O): backtrace_nat.c caml/alloc.h caml/misc.h caml/config.h \
- caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
- caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/backtrace_prim.h \
- caml/backtrace.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \
- caml/mlvalues.h caml/stack.h
-backtrace_npic.$(O): backtrace.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/backtrace.h caml/exec.h \
- caml/backtrace_prim.h caml/backtrace.h caml/fail.h caml/debugger.h
-dynlink_nat_npic.$(O): dynlink_nat.c caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
- caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/stack.h caml/callback.h caml/codefrag.h caml/alloc.h caml/intext.h \
- caml/io.h caml/osdeps.h caml/memory.h caml/fail.h caml/signals.h \
- caml/hooks.h
-debugger_npic.$(O): debugger.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/codefrag.h caml/config.h caml/debugger.h caml/misc.h caml/osdeps.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/skiplist.h
-meta_npic.$(O): meta.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/codefrag.h \
- caml/config.h caml/debugger.h caml/fail.h caml/fix_code.h caml/interp.h \
- caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \
- caml/signals.h caml/stacks.h caml/memory.h
-dynlink_npic.$(O): dynlink.c caml/config.h caml/m.h caml/s.h caml/alloc.h \
- caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \
- caml/domain_state.tbl caml/dynlink.h caml/fail.h caml/mlvalues.h \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \
- caml/memory.h caml/prims.h caml/signals.h
-clambda_checks_npic.$(O): clambda_checks.c caml/mlvalues.h caml/config.h caml/m.h \
- caml/s.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
- caml/domain_state.tbl
-spacetime_nat_npic.$(O): spacetime_nat.c caml/config.h caml/m.h caml/s.h \
- caml/alloc.h caml/misc.h caml/config.h caml/mlvalues.h \
- caml/domain_state.h caml/domain_state.tbl caml/backtrace_prim.h \
- caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h caml/intext.h \
- caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \
- caml/roots.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \
- caml/stack.h
-spacetime_snapshot_npic.$(O): spacetime_snapshot.c caml/alloc.h caml/misc.h \
- caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \
- caml/domain_state.tbl caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
- caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/gc_ctrl.h \
- caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
- caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
- caml/memory.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \
- caml/stack.h
-afl_npic.$(O): afl.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \
- caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \
- caml/domain_state.tbl caml/osdeps.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h
-bigarray_npic.$(O): bigarray.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/bigarray.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
- caml/hash.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \
- caml/signals.h
-memprof_npic.$(O): memprof.c caml/memprof.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \
- caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
- caml/minor_gc.h caml/address_class.h caml/domain.h caml/fail.h \
- caml/alloc.h caml/callback.h caml/signals.h caml/memory.h \
- caml/minor_gc.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h \
- caml/weak.h caml/stack.h caml/misc.h caml/compact.h caml/printexc.h \
- caml/eventlog.h
-domain_npic.$(O): domain.c caml/domain_state.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h
-skiplist_npic.$(O): skiplist.c caml/config.h caml/m.h caml/s.h caml/memory.h \
- caml/config.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \
- caml/address_class.h caml/domain.h caml/misc.h caml/skiplist.h
-codefrag_npic.$(O): codefrag.c caml/codefrag.h caml/misc.h caml/config.h caml/m.h \
- caml/s.h caml/md5.h caml/mlvalues.h caml/misc.h caml/domain_state.h \
- caml/domain_state.tbl caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
- caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \
- caml/skiplist.h
-win32_npic.$(O): win32.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \
- caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \
- caml/address_class.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \
- caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
- caml/domain.h caml/misc.h caml/osdeps.h caml/memory.h caml/signals.h \
- caml/sys.h caml/config.h
ROOTDIR = ..
--include $(ROOTDIR)/Makefile.config
--include $(ROOTDIR)/Makefile.common
+include $(ROOTDIR)/Makefile.common
# Lists of source files
signals_byt printexc backtrace_byt backtrace compare ints eventlog \
floats str array io extern intern hash sys meta parsing gc_ctrl md5 obj \
lexing callback debugger weak compact finalise custom dynlink \
- spacetime_byt afl $(UNIX_OR_WIN32) bigarray main memprof domain \
+ afl $(UNIX_OR_WIN32) bigarray main memprof domain \
skiplist codefrag)
NATIVE_C_SOURCES := $(addsuffix .c, \
floats str array io extern intern hash sys parsing gc_ctrl eventlog md5 obj \
lexing $(UNIX_OR_WIN32) printexc callback weak compact finalise custom \
globroots backtrace_nat backtrace dynlink_nat debugger meta \
- dynlink clambda_checks spacetime_nat spacetime_snapshot afl bigarray \
+ dynlink clambda_checks afl bigarray \
memprof domain skiplist codefrag)
-# The other_files variable stores the list of files whose dependencies
-# should be computed by `make depend` although they do not need to be
-# compiled on the current build system
-ifeq "$(UNIX_OR_WIN32)" "win32"
-other_files := unix.c
-else
-other_files := win32.c
-endif
+GENERATED_HEADERS := caml/opnames.h caml/version.h caml/jumptbl.h
+CONFIG_HEADERS := caml/m.h caml/s.h
ifeq "$(TOOLCHAIN)" "msvc"
ASM_EXT := asm
ASM_OBJECTS := $(ASM_SOURCES:.$(ASM_EXT)=.$(O))
-libcamlrun_OBJECTS := $(BYTECODE_C_SOURCES:.c=_b.$(O))
+libcamlrun_OBJECTS := $(BYTECODE_C_SOURCES:.c=.b.$(O))
-libcamlrund_OBJECTS := $(BYTECODE_C_SOURCES:.c=_bd.$(O)) \
- instrtrace_bd.$(O)
+libcamlrund_OBJECTS := $(BYTECODE_C_SOURCES:.c=.bd.$(O)) \
+ instrtrace.bd.$(O)
-libcamlruni_OBJECTS := $(BYTECODE_C_SOURCES:.c=_bi.$(O))
+libcamlruni_OBJECTS := $(BYTECODE_C_SOURCES:.c=.bi.$(O))
-libcamlrunpic_OBJECTS := $(BYTECODE_C_SOURCES:.c=_bpic.$(O))
+libcamlrunpic_OBJECTS := $(BYTECODE_C_SOURCES:.c=.bpic.$(O))
-libasmrun_OBJECTS := $(NATIVE_C_SOURCES:.c=_n.$(O)) $(ASM_OBJECTS)
+libasmrun_OBJECTS := $(NATIVE_C_SOURCES:.c=.n.$(O)) $(ASM_OBJECTS)
-libasmrund_OBJECTS := $(NATIVE_C_SOURCES:.c=_nd.$(O)) $(ASM_OBJECTS)
+libasmrund_OBJECTS := $(NATIVE_C_SOURCES:.c=.nd.$(O)) $(ASM_OBJECTS)
-libasmruni_OBJECTS := $(NATIVE_C_SOURCES:.c=_ni.$(O)) $(ASM_OBJECTS)
+libasmruni_OBJECTS := $(NATIVE_C_SOURCES:.c=.ni.$(O)) $(ASM_OBJECTS)
-libasmrunpic_OBJECTS := $(NATIVE_C_SOURCES:.c=_npic.$(O)) \
+libasmrunpic_OBJECTS := $(NATIVE_C_SOURCES:.c=.npic.$(O)) \
$(ASM_OBJECTS:.$(O)=_libasmrunpic.$(O))
# General (non target-specific) assembler and compiler flags
OC_CFLAGS += -g
endif
+OC_CPPFLAGS += -DCAMLDLLIMPORT=
+
OC_NATIVE_CPPFLAGS = -DNATIVE_CODE -DTARGET_$(ARCH)
ifeq "$(UNIX_OR_WIN32)" "unix"
OC_NATIVE_CPPFLAGS += -DMODEL_$(MODEL)
endif
-OC_NATIVE_CPPFLAGS += -DSYS_$(SYSTEM) $(IFLEXDIR) $(LIBUNWIND_INCLUDE_FLAGS)
+OC_NATIVE_CPPFLAGS += -DSYS_$(SYSTEM) $(IFLEXDIR)
OC_DEBUG_CPPFLAGS=-DDEBUG
OC_INSTR_CPPFLAGS=-DCAML_INSTR
ifeq "$(TOOLCHAIN)" "msvc"
ASMFLAGS=
-ifeq ($(WITH_SPACETIME),true)
-ASMFLAGS=/DWITH_SPACETIME
-endif
endif
ASPPFLAGS = -DSYS_$(SYSTEM) -I$(ROOTDIR)/runtime
all: $(BYTECODE_STATIC_LIBRARIES) $(BYTECODE_SHARED_LIBRARIES) $(PROGRAMS)
.PHONY: allopt
+ifneq "$(NATIVE_COMPILER)" "false"
allopt: $(NATIVE_STATIC_LIBRARIES) $(NATIVE_SHARED_LIBRARIES)
+else
+allopt:
+ $(error The build has been configured with --disable-native-compiler)
+endif
INSTALL_INCDIR=$(INSTALL_LIBDIR)/caml
.PHONY: install
rm -f *.o *.obj *.a *.lib *.so *.dll ld.conf
rm -f ocamlrun ocamlrund ocamlruni
rm -f ocamlrun.exe ocamlrund.exe ocamlruni.exe
- rm -f primitives primitives.new prims.c caml/opnames.h caml/jumptbl.h
- rm -f caml/version.h domain_state*.inc
+ rm -f primitives primitives.new prims.c $(GENERATED_HEADERS)
+ rm -f domain_state*.inc
+ rm -rf $(DEPDIR)
.PHONY: distclean
distclean: clean
# Target-specific preprocessor and compiler flags
-%_bd.$(O): OC_CPPFLAGS += $(OC_DEBUG_CPPFLAGS)
+%.bd.$(O): OC_CPPFLAGS += $(OC_DEBUG_CPPFLAGS)
+%.bd.$(D): OC_CPPFLAGS += $(OC_DEBUG_CPPFLAGS)
-%_bi.$(O): OC_CPPFLAGS += $(OC_INSTR_CPPFLAGS)
+%.bi.$(O): OC_CPPFLAGS += $(OC_INSTR_CPPFLAGS)
+%.bi.$(D): OC_CPPFLAGS += $(OC_INSTR_CPPFLAGS)
-%_bpic.$(O): OC_CFLAGS += $(SHAREDLIB_CFLAGS)
+%.bpic.$(O): OC_CFLAGS += $(SHAREDLIB_CFLAGS)
-%_n.$(O): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS)
+%.n.$(O): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS)
+%.n.$(D): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS)
-%_nd.$(O): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) $(OC_DEBUG_CPPFLAGS)
+%.nd.$(O): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) $(OC_DEBUG_CPPFLAGS)
+%.nd.$(D): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) $(OC_DEBUG_CPPFLAGS)
-%_ni.$(O): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) $(OC_INSTR_CPPFLAGS)
+%.ni.$(O): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) $(OC_INSTR_CPPFLAGS)
+%.ni.$(D): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) $(OC_INSTR_CPPFLAGS)
-%_npic.$(O): OC_CFLAGS += $(SHAREDLIB_CFLAGS)
-%_npic.$(O): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS)
+%.npic.$(O): OC_CFLAGS += $(SHAREDLIB_CFLAGS)
+%.npic.$(O): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS)
+%.npic.$(D): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS)
# Compilation of C files
# that corresponds to the name of the generated object file
# (without the extension, which is added by the macro)
define COMPILE_C_FILE
+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
+# 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
+# dependencies to ensure that they exist before dependencies are computed.
+$(DEPDIR)/$(1).$(D): %.c | $(DEPDIR) $(GENERATED_HEADERS)
+ $$(DEP_CC) $$(OC_CPPFLAGS) $$(CPPFLAGS) $$< -MT \
+ '$$*$(subst %,,$(1)).$(O)' -MF $$@
+endif
$(1).$(O): %.c
- $$(CC) -c $$(OC_CFLAGS) $$(OC_CPPFLAGS) $$(OUTPUTOBJ)$$@ $$<
+else
+$(1).$(O): %.c $(CONFIG_HEADERS) $(GENERATED_HEADERS) $(RUNTIME_HEADERS)
+endif
+ $$(CC) -c $$(OC_CFLAGS) $$(CFLAGS) $$(OC_CPPFLAGS) $$(CPPFLAGS) \
+ $$(OUTPUTOBJ)$$@ $$<
endef
-object_types := % %_b %_bd %_bi %_bpic %_n %_nd %_ni %_np %_npic
+object_types := % %.b %.bd %.bi %.bpic
+ifneq "$(NATIVE_COMPILER)" "false"
+object_types += %.n %.nd %.ni %.np %.npic
+endif
$(foreach object_type, $(object_types), \
$(eval $(call COMPILE_C_FILE,$(object_type))))
-dynlink_%.$(O): OC_CPPFLAGS += $(STDLIB_CPP_FLAG)
+dynlink.%.$(O): OC_CPPFLAGS += $(STDLIB_CPP_FLAG)
$(foreach object_type,$(subst %,,$(object_types)), \
$(eval dynlink$(object_type).$(O): $(ROOTDIR)/Makefile.config))
# Dependencies
-.PHONY: depend
-ifeq "$(TOOLCHAIN)" "msvc"
-depend:
- $(error Dependencies cannot be regenerated using the MSVC ports)
-else
-
-NATIVE_DEP_CPPFLAGS := $(OC_CPPFLAGS) $(OC_NATIVE_CPPFLAGS)
-BYTECODE_DEP_FILES := $(BYTECODE_C_SOURCES) $(other_files) instrtrace.c
-NATIVE_DEP_FILES := $(NATIVE_C_SOURCES) $(other_files)
-
-depend: *.c caml/opnames.h caml/jumptbl.h caml/version.h
- $(CC) -MM $(OC_CPPFLAGS) $(BYTECODE_DEP_FILES) | \
- sed -e 's/\([^.]*\)\.o/\1_b.$$(O)/' > .depend
- $(CC) -MM $(OC_CPPFLAGS) $(OC_DEBUG_CPPFLAGS) \
- $(BYTECODE_DEP_FILES) | \
- sed -e 's/\([^.]*\)\.o/\1_bd.$$(O)/' >> .depend
- $(CC) -MM $(OC_CPPFLAGS) $(OC_INSTR_CPPFLAGS) \
- $(BYTECODE_DEP_FILES) | \
- sed -e 's/\([^.]*\)\.o/\1_bi.$$(O)/' >> .depend
- $(CC) -MM $(OC_CPPFLAGS) $(BYTECODE_DEP_FILES) | \
- sed -e 's/\([^.]*\)\.o/\1_bpic.$$(O)/' >> .depend
- $(CC) -MM $(NATIVE_DEP_CPPFLAGS) $(NATIVE_DEP_FILES) | \
- sed -e 's/\([^.]*\)\.o/\1_n.$$(O)/' >> .depend
- $(CC) -MM $(NATIVE_DEP_CPPFLAGS) $(OC_DEBUG_CPPFLAGS) \
- $(NATIVE_DEP_FILES) | \
- sed -e 's/\([^.]*\)\.o/\1_nd.$$(O)/' >> .depend
- $(CC) -MM $(NATIVE_DEP_CPPFLAGS) $(OC_INSTR_CPPFLAGS) \
- $(NATIVE_DEP_FILES) | \
- sed -e 's/\([^.]*\)\.o/\1_ni.$$(O)/' >> .depend
- $(CC) -MM $(NATIVE_DEP_CPPFLAGS) $(NATIVE_DEP_FILES) | \
- sed -e 's/\([^.]*\)\.o/\1_npic.$$(O)/' >> .depend
+DEP_FILES := $(addsuffix .b, $(basename $(BYTECODE_C_SOURCES) instrtrace))
+ifneq "$(NATIVE_COMPILER)" "false"
+DEP_FILES += $(addsuffix .n, $(basename $(NATIVE_C_SOURCES)))
endif
+DEP_FILES += $(addsuffix d, $(DEP_FILES)) \
+ $(addsuffix i, $(DEP_FILES)) \
+ $(addsuffix pic, $(DEP_FILES))
+DEP_FILES := $(addsuffix .$(D), $(DEP_FILES))
-include .depend
+ifeq "$(COMPUTE_DEPS)" "true"
+include $(addprefix $(DEPDIR)/, $(DEP_FILES))
+endif
/* Runtime support for afl-fuzz */
#include "caml/config.h"
-#if !defined(HAS_SYS_SHM_H)
+#if !defined(HAS_SYS_SHM_H) || !defined(HAS_SHMAT)
#include "caml/mlvalues.h"
return result;
}
-CAMLexport value caml_alloc_small_with_my_or_given_profinfo (mlsize_t wosize,
- tag_t tag, uintnat profinfo)
-{
- if (profinfo == 0) {
- return caml_alloc_small(wosize, tag);
- }
- else {
- value result;
-
- CAMLassert (wosize > 0);
- CAMLassert (wosize <= Max_young_wosize);
- CAMLassert (tag < 256);
- Alloc_small_with_profinfo (result, wosize, tag, profinfo);
- return result;
- }
-}
-
/* [n] is a number of words (fields) */
CAMLexport value caml_alloc_tuple(mlsize_t n)
{
{
mlsize_t wosize = Long_val(vsize), offset = Long_val(voffset);
value v = caml_alloc(wosize, Closure_tag);
+ /* The following choice of closure info causes the GC to skip
+ the whole block contents. This is correct since the dummy
+ block contains no pointers into the heap. However, the block
+ cannot be marshaled or hashed, because not all closinfo fields
+ and infix header fields are correctly initialized. */
+ Closinfo_val(v) = Make_closinfo(0, wosize);
if (offset > 0) {
v += Bsize_wsize(offset);
Hd_val(v) = Make_header(offset, Infix_tag, Caml_white);
dummy = dummy - Infix_offset_val(dummy);
size = Wosize_val(clos);
CAMLassert (size == Wosize_val(dummy));
+ /* It is safe to use [caml_modify] to copy code pointers
+ from [clos] to [dummy], because the value being overwritten is
+ an integer, and the new "value" is a pointer outside the minor
+ heap. */
for (i = 0; i < size; i++) {
caml_modify (&Field(dummy, i), Field(clos, i));
}
Tag_val(dummy) = tag;
size = Wosize_val(newval);
CAMLassert (size == Wosize_val(dummy));
+ /* See comment above why this is safe even if [tag == Closure_tag]
+ and some of the "values" being copied are actually code pointers. */
for (i = 0; i < size; i++){
caml_modify (&Field(dummy, i), Field(newval, i));
}
}
return Val_unit;
}
+
+CAMLexport value caml_alloc_some(value v)
+{
+ CAMLparam1(v);
+ value some = caml_alloc_small(1, 0);
+ Field(some, 0) = v;
+ CAMLreturn(some);
+}
#define GREL(r) r@GOTPCREL
#define GCALL(r) r@PLT
#if defined(FUNCTION_SECTIONS)
-#define TEXT_SECTION(name) .section .text.##name,"ax",%progbits
+#define TEXT_SECTION(name) .section .text.caml.##name,"ax",%progbits
#else
#define TEXT_SECTION(name)
#endif
#define EIGHT_ALIGN 8
#define SIXTEEN_ALIGN 16
#define FUNCTION(name) \
- TEXT_SECTION(caml.##name); \
+ TEXT_SECTION(name); \
.globl name; \
.type name,@function; \
.align FUNCTION_ALIGN; \
#define C_ARG_4 %rcx
#endif
+ .text
+
#if defined(FUNCTION_SECTIONS)
TEXT_SECTION(caml_hot__code_begin)
.globl G(caml_hot__code_begin)
G(caml_hot__code_end):
#endif
- .text
-
+ TEXT_SECTION(caml_system__code_begin)
.globl G(caml_system__code_begin)
G(caml_system__code_begin):
ret /* just one instruction, so that debuggers don't display
movq %rsp, Caml_state(gc_regs)
/* Save young_ptr */
movq %r15, Caml_state(young_ptr)
-#ifdef WITH_SPACETIME
- STORE_VAR(%r13, caml_spacetime_trie_node_ptr)
-#endif
/* Save floating-point registers */
subq $(16*8), %rsp; CFI_ADJUST (16*8);
movsd %xmm0, 0*8(%rsp)
movq %rsp, Caml_state(bottom_of_stack)
/* equivalent to pushing last return address */
subq $8, %rsp; CFI_ADJUST(8)
-#ifdef WITH_SPACETIME
- /* Record the trie node hole pointer that corresponds to
- [Caml_state->last_return_address] */
- STORE_VAR(%r13, caml_spacetime_trie_node_ptr)
-#endif
/* Touch the stack to trigger a recoverable segfault
if insufficient space remains */
subq $(STACK_PROBE_SIZE), %rsp; CFI_ADJUST(STACK_PROBE_SIZE);
/* Common code for caml_start_program and caml_callback* */
LBL(caml_start_program):
/* Build a callback link */
-#ifdef WITH_SPACETIME
- PUSH_VAR(caml_spacetime_trie_node_ptr)
-#else
subq $8, %rsp; CFI_ADJUST (8) /* stack 16-aligned */
-#endif
pushq Caml_state(gc_regs); CFI_ADJUST(8)
pushq Caml_state(last_return_address); CFI_ADJUST(8)
pushq Caml_state(bottom_of_stack); CFI_ADJUST(8)
-#ifdef WITH_SPACETIME
- /* Save arguments to caml_callback* */
- pushq %rax; CFI_ADJUST (8)
- pushq %rbx; CFI_ADJUST (8)
- pushq %rdi; CFI_ADJUST (8)
- pushq %rsi; CFI_ADJUST (8)
- /* No need to push %r12: it's callee-save. */
- movq %r12, C_ARG_1
- LEA_VAR(caml_start_program, C_ARG_2)
- call GCALL(caml_spacetime_c_to_ocaml)
- popq %rsi; CFI_ADJUST (-8)
- popq %rdi; CFI_ADJUST (-8)
- popq %rbx; CFI_ADJUST (-8)
- popq %rax; CFI_ADJUST (-8)
-#endif
/* Setup alloc ptr */
movq Caml_state(young_ptr), %r15
/* Build an exception handler */
pushq %r13; CFI_ADJUST(8)
pushq Caml_state(exception_pointer); CFI_ADJUST(8)
movq %rsp, Caml_state(exception_pointer)
-#ifdef WITH_SPACETIME
- LOAD_VAR(caml_spacetime_trie_node_ptr, %r13)
-#endif
/* Call the OCaml code */
call *%r12
LBL(107):
popq Caml_state(bottom_of_stack); CFI_ADJUST(-8)
popq Caml_state(last_return_address); CFI_ADJUST(-8)
popq Caml_state(gc_regs); CFI_ADJUST(-8)
-#ifdef WITH_SPACETIME
- POP_VAR(caml_spacetime_trie_node_ptr)
-#else
addq $8, %rsp; CFI_ADJUST (-8);
-#endif
/* Restore callee-save registers. */
POP_CALLEE_SAVE_REGS
/* Return to caller. */
CFI_ENDPROC
ENDFUNCTION(G(caml_ml_array_bound_error))
+ TEXT_SECTION(caml_system__code_end)
.globl G(caml_system__code_end)
G(caml_system__code_end):
.quad 0
.string "amd64.S"
-#ifdef WITH_SPACETIME
- .data
- .globl G(caml_system__spacetime_shapes)
- .align EIGHT_ALIGN
-G(caml_system__spacetime_shapes):
- .quad G(caml_start_program)
- .quad 2 /* indirect call point to OCaml code */
- .quad LBL(107) /* in caml_start_program / caml_callback* */
- .quad 0 /* end of shapes for caml_start_program */
- .quad 0 /* end of shape table */
- .align EIGHT_ALIGN
-#endif
-
#if defined(SYS_macosx)
.literal16
#elif defined(SYS_mingw64) || defined(SYS_cygwin)
EXTRN caml_program: NEAR
EXTRN caml_array_bound_error: NEAR
EXTRN caml_stash_backtrace: NEAR
-IFDEF WITH_SPACETIME
- EXTRN caml_spacetime_trie_node_ptr: QWORD
- EXTRN caml_spacetime_c_to_ocaml: NEAR
-ENDIF
INCLUDE domain_state64.inc
add rsp, 01000h
; Save young_ptr
Store_young_ptr r15
-IFDEF WITH_SPACETIME
- mov caml_spacetime_trie_node_ptr, r13
-ENDIF
; Build array of registers, save it into Caml_state(gc_regs)
push rbp
push r11
pop r12
Store_last_return_address r12
Store_bottom_of_stack rsp
-IFDEF WITH_SPACETIME
- ; Record the trie node hole pointer that corresponds to
- ; [Caml_state(last_return_address)]
- mov caml_spacetime_trie_node_ptr, r13
-ENDIF
; Touch the stack to trigger a recoverable segfault
; if insufficient space remains
sub rsp, 01000h
; Common code for caml_start_program and caml_callback*
L106:
; Build a callback link
-IFDEF WITH_SPACETIME
- push caml_spacetime_trie_node_ptr
-ELSE
sub rsp, 8 ; stack 16-aligned
-ENDIF
Push_gc_regs
Push_last_return_address
Push_bottom_of_stack
-IFDEF WITH_SPACETIME
- ; Save arguments to caml_callback
- push rax
- push rbx
- push rdi
- push rsi
- ; No need to push r12: it is callee-save.
- mov rcx, r12
- lea rdx, caml_start_program
- call caml_spacetime_c_to_ocaml
- pop rsi
- pop rdi
- pop rbx
- pop rax
-ENDIF
; Setup alloc ptr
Load_young_ptr r15
; Build an exception handler
push r13
Push_exception_pointer
Store_exception_pointer rsp
-IFDEF WITH_SPACETIME
- mov r13, caml_spacetime_trie_node_ptr
-ENDIF
; Call the OCaml code
call r12
L107:
Pop_bottom_of_stack
Pop_last_return_address
Pop_gc_regs
-IFDEF WITH_SPACETIME
- pop caml_spacetime_trie_node_ptr
-ELSE
add rsp, 8
-ENDIF
; Restore callee-save registers.
movapd xmm6, OWORD PTR [rsp + 0*16]
movapd xmm7, OWORD PTR [rsp + 1*16]
WORD 0 ; no roots here
ALIGN 8
-IFDEF WITH_SPACETIME
- .DATA
- PUBLIC caml_system__spacetime_shapes
- ALIGN 8
-caml_system__spacetime_shapes LABEL QWORD
- QWORD caml_start_program
- QWORD 2 ; indirect call point to OCaml code
- QWORD L107 ; in caml_start_program / caml_callback*
- QWORD 0 ; end of shapes in caml_start_program
- QWORD 0 ; end of shape table
- ALIGN 8
-ENDIF
-
PUBLIC caml_negf_mask
ALIGN 16
caml_negf_mask LABEL QWORD
#endif
#if defined(FUNCTION_SECTIONS)
-#define TEXT_SECTION(name) .section .text.##name,"ax",%progbits
+#define TEXT_SECTION(name) .section .text.caml.##name,"ax",%progbits
#else
#define TEXT_SECTION(name)
#endif
#define FUNCTION(name) \
- TEXT_SECTION(caml.##name); \
+ TEXT_SECTION(name); \
.align 2; \
.globl name; \
.type name, %function; \
#define Caml_state(var) [domain_state_ptr, 8*domain_field_caml_##var]
/* Allocation functions and GC interface */
+ TEXT_SECTION(caml_system__code_begin)
.globl caml_system__code_begin
caml_system__code_begin:
CFI_ENDPROC
.size caml_ml_array_bound_error, .-caml_ml_array_bound_error
+ TEXT_SECTION(caml_system__code_end)
.globl caml_system__code_end
caml_system__code_end:
#define TRAP_PTR x26
#define ALLOC_PTR x27
#define ALLOC_LIMIT x28
-#define ARG x15
+#define ADDITIONAL_ARG x8
#define TMP x16
#define TMP2 x17
-#define ARG_DOMAIN_STATE_PTR x18
#define C_ARG_1 x0
#define C_ARG_2 x1
#endif
.set domain_curr_field, 0
+#if defined(SYS_macosx)
+#define DOMAIN_STATE(c_type, name) DOMAIN_STATE c_type, name
+ .macro DOMAIN_STATE c_type, name
+ .equ domain_field_caml_\name, domain_curr_field
+ .set domain_curr_field, domain_curr_field + 1
+ .endm
+#else
#define DOMAIN_STATE(c_type, name) \
.equ domain_field_caml_##name, domain_curr_field ; \
.set domain_curr_field, domain_curr_field + 1
+#endif
#include "../runtime/caml/domain_state.tbl"
#undef DOMAIN_STATE
#define Caml_state(var) [x25, 8*domain_field_caml_##var]
-#if defined(__PIC__)
+/* Globals and labels */
+#if defined(SYS_macosx)
+#define G(sym) _##sym
+#define L(lbl) L##lbl
+#else
+#define G(sym) sym
+#define L(lbl) .L##lbl
+#endif
+
+#if defined(SYS_macosx)
+#define ADDRGLOBAL(reg,symb) ADDRGLOBAL reg, symb
+ .macro ADDRGLOBAL reg, symb
+ adrp TMP2, G(\symb)@GOTPAGE
+ ldr \reg, [TMP2, G(\symb)@GOTPAGEOFF]
+ .endm
+#elif defined(__PIC__)
#define ADDRGLOBAL(reg,symb) \
- adrp TMP2, :got:symb; \
- ldr reg, [TMP2, #:got_lo12:symb]
+ adrp TMP2, :got:G(symb); \
+ ldr reg, [TMP2, #:got_lo12:G(symb)]
#else
#define ADDRGLOBAL(reg,symb) \
- adrp reg, symb; \
- add reg, reg, #:lo12:symb
+ adrp reg, G(symb); \
+ add reg, reg, #:lo12:G(symb)
#endif
#if defined(FUNCTION_SECTIONS)
-#define TEXT_SECTION(name) .section .text.##name,"ax",%progbits
+#define TEXT_SECTION(name) .section .text.caml.##name,"ax",%progbits
#else
#define TEXT_SECTION(name)
#endif
#if defined(FUNCTION_SECTIONS)
TEXT_SECTION(caml_hot__code_begin)
- .globl caml_hot__code_begin
-caml_hot__code_begin:
+ .globl G(caml_hot__code_begin)
+G(caml_hot__code_begin):
TEXT_SECTION(caml_hot__code_end)
- .globl caml_hot__code_end
-caml_hot__code_end:
+ .globl G(caml_hot__code_end)
+G(caml_hot__code_end):
#endif
+#if defined(SYS_macosx)
+
+#define FUNCTION(name) FUNCTION name
+ .macro FUNCTION name
+ TEXT_SECTION(G(\name))
+ .align 2
+ .globl G(\name)
+G(\name):
+ .endm
+#define END_FUNCTION(name)
+
+#define OBJECT(name) OBJECT name
+ .macro OBJECT name
+ .data
+ .align 3
+ .globl G(\name)
+G(\name):
+ .endm
+#define END_OBJECT(name)
+
+#else
+
#define FUNCTION(name) \
- TEXT_SECTION(caml.##name); \
- .align 2; \
- .globl name; \
- .type name, %function; \
-name:
+ TEXT_SECTION(name); \
+ .align 2; \
+ .globl G(name); \
+ .type G(name), %function; \
+G(name):
+#define END_FUNCTION(name) \
+ .size G(name), .-G(name)
+
+#define OBJECT(name) \
+ .data; \
+ .align 3; \
+ .globl G(name); \
+ .type G(name), %object; \
+G(name):
+#define END_OBJECT(name) \
+ .size G(name), .-G(name)
+#endif
/* Allocation functions and GC interface */
- .globl caml_system__code_begin
-caml_system__code_begin:
+ TEXT_SECTION(caml_system__code_begin)
+ .globl G(caml_system__code_begin)
+G(caml_system__code_begin):
FUNCTION(caml_call_gc)
CFI_STARTPROC
-.Lcaml_call_gc:
+L(caml_call_gc):
/* Record return address */
str x30, Caml_state(last_return_address)
/* Record lowest stack address */
/* Save trap pointer in case an exception is raised during GC */
str TRAP_PTR, Caml_state(exception_pointer)
/* Call the garbage collector */
- bl caml_garbage_collection
+ bl G(caml_garbage_collection)
/* Restore registers */
ldp x0, x1, [sp, 16]
ldp x2, x3, [sp, 32]
ldp x29, x30, [sp], 400
ret
CFI_ENDPROC
- .size caml_call_gc, .-caml_call_gc
+ END_FUNCTION(caml_call_gc)
FUNCTION(caml_alloc1)
CFI_STARTPROC
sub ALLOC_PTR, ALLOC_PTR, #16
cmp ALLOC_PTR, ALLOC_LIMIT
- b.lo .Lcaml_call_gc
+ b.lo L(caml_call_gc)
ret
CFI_ENDPROC
- .size caml_alloc1, .-caml_alloc1
+ END_FUNCTION(caml_alloc1)
FUNCTION(caml_alloc2)
CFI_STARTPROC
sub ALLOC_PTR, ALLOC_PTR, #24
cmp ALLOC_PTR, ALLOC_LIMIT
- b.lo .Lcaml_call_gc
+ b.lo L(caml_call_gc)
ret
CFI_ENDPROC
- .size caml_alloc2, .-caml_alloc2
+ END_FUNCTION(caml_alloc2)
FUNCTION(caml_alloc3)
CFI_STARTPROC
sub ALLOC_PTR, ALLOC_PTR, #32
cmp ALLOC_PTR, ALLOC_LIMIT
- b.lo .Lcaml_call_gc
+ b.lo L(caml_call_gc)
ret
CFI_ENDPROC
- .size caml_alloc3, .-caml_alloc3
+ END_FUNCTION(caml_alloc3)
FUNCTION(caml_allocN)
CFI_STARTPROC
- sub ALLOC_PTR, ALLOC_PTR, ARG
+ sub ALLOC_PTR, ALLOC_PTR, ADDITIONAL_ARG
cmp ALLOC_PTR, ALLOC_LIMIT
- b.lo .Lcaml_call_gc
+ b.lo L(caml_call_gc)
ret
CFI_ENDPROC
- .size caml_allocN, .-caml_allocN
+ END_FUNCTION(caml_allocN)
/* Call a C function from OCaml */
-/* Function to call is in ARG */
+/* Function to call is in ADDITIONAL_ARG */
FUNCTION(caml_c_call)
CFI_STARTPROC
str ALLOC_PTR, Caml_state(young_ptr)
str TRAP_PTR, Caml_state(exception_pointer)
/* Call the function */
- blr ARG
+ blr ADDITIONAL_ARG
/* Reload alloc ptr and alloc limit */
ldr ALLOC_PTR, Caml_state(young_ptr)
ldr ALLOC_LIMIT, Caml_state(young_limit)
/* Return */
ret x19
CFI_ENDPROC
- .size caml_c_call, .-caml_c_call
+ END_FUNCTION(caml_c_call)
/* Start the OCaml program */
FUNCTION(caml_start_program)
CFI_STARTPROC
- mov ARG_DOMAIN_STATE_PTR, C_ARG_1
- ADDRGLOBAL(ARG, caml_program)
+ mov TMP, C_ARG_1
+ ADDRGLOBAL(TMP2, caml_program)
/* Code shared with caml_callback* */
-/* Address of OCaml code to call is in ARG */
+/* Address of domain state is in TMP */
+/* Address of OCaml code to call is in TMP2 */
/* Arguments to the OCaml code are in x0...x7 */
-.Ljump_to_caml:
+L(jump_to_caml):
/* Set up stack frame and save callee-save registers */
CFI_OFFSET(29, -160)
CFI_OFFSET(30, -152)
stp d12, d13, [sp, 128]
stp d14, d15, [sp, 144]
/* Load domain state pointer from argument */
- mov DOMAIN_STATE_PTR, ARG_DOMAIN_STATE_PTR
+ mov DOMAIN_STATE_PTR, TMP
/* Setup a callback link on the stack */
ldr x8, Caml_state(bottom_of_stack)
ldr x9, Caml_state(last_return_address)
str x10, [sp, 16]
/* Setup a trap frame to catch exceptions escaping the OCaml code */
ldr x8, Caml_state(exception_pointer)
- adr x9, .Ltrap_handler
+ adr x9, L(trap_handler)
stp x8, x9, [sp, -16]!
CFI_ADJUST(16)
add TRAP_PTR, sp, #0
ldr ALLOC_PTR, Caml_state(young_ptr)
ldr ALLOC_LIMIT, Caml_state(young_limit)
/* Call the OCaml code */
- blr ARG
-.Lcaml_retaddr:
+ blr TMP2
+L(caml_retaddr):
/* Pop the trap frame, restoring caml_exception_pointer */
ldr x8, [sp], 16
CFI_ADJUST(-16)
str x8, Caml_state(exception_pointer)
/* Pop the callback link, restoring the global variables */
-.Lreturn_result:
+L(return_result):
ldr x10, [sp, 16]
ldp x8, x9, [sp], 32
CFI_ADJUST(-32)
/* Return to C caller */
ret
CFI_ENDPROC
- .type .Lcaml_retaddr, %function
- .size .Lcaml_retaddr, .-.Lcaml_retaddr
- .size caml_start_program, .-caml_start_program
+ END_FUNCTION(caml_start_program)
/* The trap handler */
.align 2
-.Ltrap_handler:
+L(trap_handler):
CFI_STARTPROC
/* Save exception pointer */
str TRAP_PTR, Caml_state(exception_pointer)
/* Encode exception bucket as an exception result */
orr x0, x0, #2
/* Return it */
- b .Lreturn_result
+ b L(return_result)
CFI_ENDPROC
- .type .Ltrap_handler, %function
- .size .Ltrap_handler, .-.Ltrap_handler
/* Raise an exception from OCaml */
mov x1, x30 /* arg2: pc of raise */
add x2, sp, #0 /* arg3: sp of raise */
mov x3, TRAP_PTR /* arg4: sp of handler */
- bl caml_stash_backtrace
+ bl G(caml_stash_backtrace)
/* Restore exception bucket and raise */
mov x0, x19
b 1b
CFI_ENDPROC
- .size caml_raise_exn, .-caml_raise_exn
+ END_FUNCTION(caml_raise_exn)
/* Raise an exception from C */
ldr x1, Caml_state(last_return_address) /* arg2: pc of raise */
ldr x2, Caml_state(bottom_of_stack) /* arg3: sp of raise */
mov x3, TRAP_PTR /* arg4: sp of handler */
- bl caml_stash_backtrace
+ bl G(caml_stash_backtrace)
/* Restore exception bucket and raise */
mov x0, x19
b 1b
CFI_ENDPROC
- .size caml_raise_exception, .-caml_raise_exception
+ END_FUNCTION(caml_raise_exception)
/* Callback from C to OCaml */
CFI_STARTPROC
/* Initial shuffling of arguments */
/* (x0 = Caml_state, x1 = closure, [x2] = first arg) */
- mov ARG_DOMAIN_STATE_PTR, x0
+ mov TMP, x0
ldr x0, [x2] /* x0 = first arg */
/* x1 = closure environment */
- ldr ARG, [x1] /* code pointer */
- b .Ljump_to_caml
+ ldr TMP2, [x1] /* code pointer */
+ b L(jump_to_caml)
CFI_ENDPROC
- .type caml_callback_asm, %function
- .size caml_callback_asm, .-caml_callback_asm
+ END_FUNCTION(caml_callback_asm)
- TEXT_SECTION(caml_callback2_asm)
- .align 2
- .globl caml_callback2_asm
-caml_callback2_asm:
+FUNCTION(caml_callback2_asm)
CFI_STARTPROC
/* Initial shuffling of arguments */
/* (x0 = Caml_state, x1 = closure, [x2] = arg1, [x2,8] = arg2) */
- mov ARG_DOMAIN_STATE_PTR, x0
- mov TMP, x1
+ mov TMP, x0
+ mov TMP2, x1
ldp x0, x1, [x2, 0] /* x0 = first arg, x1 = second arg */
- mov x2, TMP /* x2 = closure environment */
- ADDRGLOBAL(ARG, caml_apply2)
- b .Ljump_to_caml
+ mov x2, TMP2 /* x2 = closure environment */
+ ADDRGLOBAL(TMP2, caml_apply2)
+ b L(jump_to_caml)
CFI_ENDPROC
- .type caml_callback2_asm, %function
- .size caml_callback2_asm, .-caml_callback2_asm
+ END_FUNCTION(caml_callback2_asm)
- TEXT_SECTION(caml_callback3_asm)
- .align 2
- .globl caml_callback3_asm
-caml_callback3_asm:
+FUNCTION(caml_callback3_asm)
CFI_STARTPROC
/* Initial shuffling of arguments */
/* (x0 = Caml_state, x1 = closure, [x2] = arg1, [x2,8] = arg2,
[x2,16] = arg3) */
- mov ARG_DOMAIN_STATE_PTR, x0
+ mov TMP, x0
mov x3, x1 /* x3 = closure environment */
ldp x0, x1, [x2, 0] /* x0 = first arg, x1 = second arg */
ldr x2, [x2, 16] /* x2 = third arg */
- ADDRGLOBAL(ARG, caml_apply3)
- b .Ljump_to_caml
+ ADDRGLOBAL(TMP2, caml_apply3)
+ b L(jump_to_caml)
CFI_ENDPROC
- .size caml_callback3_asm, .-caml_callback3_asm
+ END_FUNCTION(caml_callback3_asm)
FUNCTION(caml_ml_array_bound_error)
CFI_STARTPROC
- /* Load address of [caml_array_bound_error] in ARG */
- ADDRGLOBAL(ARG, caml_array_bound_error)
+ /* Load address of [caml_array_bound_error] in ADDITIONAL_ARG */
+ ADDRGLOBAL(ADDITIONAL_ARG, caml_array_bound_error)
/* Call that function */
- b caml_c_call
+ b G(caml_c_call)
CFI_ENDPROC
- .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:
+ TEXT_SECTION(caml_system__code_end)
+ .globl G(caml_system__code_end)
+G(caml_system__code_end):
/* GC roots for callback */
- .data
- .align 3
- .globl caml_system__frametable
-caml_system__frametable:
+OBJECT(caml_system__frametable)
.quad 1 /* one descriptor */
- .quad .Lcaml_retaddr /* return address into callback */
+ .quad L(caml_retaddr) /* return address into callback */
.short -1 /* negative frame size => use callback link */
.short 0 /* no roots */
.align 3
- .type caml_system__frametable, %object
- .size caml_system__frametable, .-caml_system__frametable
+ END_OBJECT(caml_system__frametable)
+#if !defined(SYS_macosx)
/* Mark stack as non-executable */
.section .note.GNU-stack,"",%progbits
+#endif
#include "caml/mlvalues.h"
#include "caml/signals.h"
#include "caml/eventlog.h"
-/* Why is caml/spacetime.h included conditionnally sometimes and not here ? */
-#include "caml/spacetime.h"
static const mlsize_t mlsize_t_max = -1;
}
/* [len] is a [value] representing number of words or floats */
-/* Spacetime profiling assumes that this function is only called from OCaml. */
CAMLprim value caml_make_vect(value len, value init)
{
CAMLparam2 (len, init);
#endif
} else {
if (size <= Max_young_wosize) {
- uintnat profinfo;
- Get_my_profinfo_with_cached_backtrace(profinfo, size);
- res = caml_alloc_small_with_my_or_given_profinfo(size, 0, profinfo);
+ res = caml_alloc_small(size, 0);
for (i = 0; i < size; i++) Field(res, i) = init;
}
else if (size > Max_wosize) caml_invalid_argument("Array.make");
/* Blitting */
+CAMLprim value caml_floatarray_blit(value a1, value ofs1, value a2, value ofs2,
+ value n)
+{
+ memmove((double *)a2 + Long_val(ofs2),
+ (double *)a1 + Long_val(ofs1),
+ Long_val(n) * sizeof(double));
+ return Val_unit;
+}
+
CAMLprim value caml_array_blit(value a1, value ofs1, value a2, value ofs2,
value n)
{
#include "caml/backtrace_prim.h"
#include "caml/fail.h"
#include "caml/debugger.h"
+#include "caml/startup.h"
void caml_init_backtrace(void)
{
print_location(&li, i);
}
}
+
+ /* See also printexc.ml */
+ switch (caml_debug_info_status()) {
+ case FILE_NOT_FOUND:
+ fprintf(stderr,
+ "(Cannot print locations:\n "
+ "bytecode executable program file not found)\n");
+ break;
+ case BAD_BYTECODE:
+ fprintf(stderr,
+ "(Cannot print locations:\n "
+ "bytecode executable program file appears to be corrupt)\n");
+ break;
+ case WRONG_MAGIC:
+ fprintf(stderr,
+ "(Cannot print locations:\n "
+ "bytecode executable program file has wrong magic number)\n");
+ break;
+ case NO_FDS:
+ fprintf(stderr,
+ "(Cannot print locations:\n "
+ "bytecode executable program file cannot be opened;\n "
+ "-- too many open files. Try running with OCAMLRUNPARAM=b=2)\n");
+ break;
+ }
+}
+
+/* Return the status of loading backtrace information (error reporting in
+ bytecode) */
+CAMLprim value caml_ml_debug_info_status(value unit)
+{
+ return Val_int(caml_debug_info_status());
}
/* Get a copy of the latest backtrace */
if (Is_long(*spv)) continue;
p = (code_t*) spv;
if(&Trap_pc(*trsp) == p) {
- *trsp = Trap_link(*trsp);
+ *trsp = *trsp + Long_val(Trap_link_offset(*trsp));
continue;
}
}
fd = caml_attempt_open(&exec_name, &trail, 1);
- if (fd < 0){
- caml_fatal_error ("executable program file not found");
+ if (fd < 0) {
+ /* Record the failure of caml_attempt_open in di->already-read */
+ di->already_read = fd;
CAMLreturn0;
}
if (caml_seek_optional_section(fd, &trail, "DBUG") != -1) {
chan = caml_open_descriptor_in(fd);
+ Lock(chan);
num_events = caml_getword(chan);
events = caml_alloc(num_events, 0);
/* Record event list */
Store_field(events, i, evl);
}
+ Unlock(chan);
caml_close_channel(chan);
di->events = process_debug_events(caml_start_code, events, &di->num_events);
+ } else {
+ close(fd);
}
CAMLreturn0;
caml_add_debug_info(caml_start_code, Val_long(caml_code_size), Val_unit);
}
+CAMLexport void caml_load_main_debug_info(void)
+{
+ if (Caml_state->backtrace_active > 1) {
+ read_main_debug_info(caml_debug_info.contents[0]);
+ }
+}
+
int caml_debug_info_available(void)
{
return (caml_debug_info.size != 0);
}
+int caml_debug_info_status(void)
+{
+ if (!caml_debug_info_available()) {
+ return 0;
+ } else {
+ return ((struct debug_info *)caml_debug_info.contents[0])->already_read;
+ }
+}
+
/* Search the event index for the given PC. Return -1 if not found. */
static struct ev_info *event_for_location(code_t pc)
{
return 1;
}
+
+int caml_debug_info_status(void)
+{
+ return 1;
+}
/* Bytecode callbacks */
+#include "caml/codefrag.h"
#include "caml/interp.h"
#include "caml/instruct.h"
#include "caml/fix_code.h"
CAMLexport int caml_callback_depth = 0;
-#ifndef LOCAL_CALLBACK_BYTECODE
static opcode_t callback_code[] = { ACC, 0, APPLY, 0, POP, 1, STOP };
-#endif
-
-#ifdef THREADED_CODE
+static int callback_code_inited = 0;
-static int callback_code_threaded = 0;
-
-static void thread_callback(void)
+static void init_callback_code(void)
{
+ caml_register_code_fragment((char *) callback_code,
+ (char *) callback_code + sizeof(callback_code),
+ DIGEST_IGNORE, NULL);
+#ifdef THREADED_CODE
caml_thread_code(callback_code, sizeof(callback_code));
- callback_code_threaded = 1;
-}
-
-#define Init_callback() if (!callback_code_threaded) thread_callback()
-
-#else
-
-#define Init_callback()
-
#endif
+ callback_code_inited = 1;
+}
CAMLexport value caml_callbackN_exn(value closure, int narg, value args[])
{
int i;
value res;
- /* some alternate bytecode implementations (e.g. a JIT translator)
- might require that the bytecode is kept in a local variable on
- the C stack */
-#ifdef LOCAL_CALLBACK_BYTECODE
- opcode_t local_callback_code[7];
-#endif
-
CAMLassert(narg + 4 <= 256);
Caml_state->extern_sp -= narg + 4;
for (i = 0; i < narg; i++) Caml_state->extern_sp[i] = args[i]; /* arguments */
-#ifndef LOCAL_CALLBACK_BYTECODE
Caml_state->extern_sp[narg] = (value)(callback_code + 4); /* return address */
Caml_state->extern_sp[narg + 1] = Val_unit; /* environment */
Caml_state->extern_sp[narg + 2] = Val_long(0); /* extra args */
Caml_state->extern_sp[narg + 3] = closure;
- Init_callback();
+ if (!callback_code_inited) init_callback_code();
callback_code[1] = narg + 3;
callback_code[3] = narg;
res = caml_interprete(callback_code, sizeof(callback_code));
-#else /*have LOCAL_CALLBACK_BYTECODE*/
- /* return address */
- Caml_state->extern_sp[narg] = (value) (local_callback_code + 4);
- Caml_state->extern_sp[narg + 1] = Val_unit; /* environment */
- Caml_state->extern_sp[narg + 2] = Val_long(0); /* extra args */
- Caml_state->extern_sp[narg + 3] = closure;
- local_callback_code[0] = ACC;
- local_callback_code[1] = narg + 3;
- local_callback_code[2] = APPLY;
- local_callback_code[3] = narg;
- local_callback_code[4] = POP;
- local_callback_code[5] = 1;
- local_callback_code[6] = STOP;
-#ifdef THREADED_CODE
- caml_thread_code(local_callback_code, sizeof(local_callback_code));
-#endif /*THREADED_CODE*/
- res = caml_interprete(local_callback_code, sizeof(local_callback_code));
- caml_release_bytecode(local_callback_code, sizeof(local_callback_code));
-#endif /*LOCAL_CALLBACK_BYTECODE*/
if (Is_exception_result(res)) Caml_state->extern_sp += narg + 4; /* PR#3419 */
return res;
}
/* Classification of addresses for GC and runtime purposes. */
+/* The current runtime supports two different configurations that
+ correspond to two different value models, depending on whether
+ "naked pointers", that do not point to a well-formed OCaml block,
+ are allowed (considered valid values).
+
+ In "classic mode", naked pointers are allowed, and the
+ implementation uses a page table. A valid value is then either:
+ - a tagged integer (Is_long or !Is_block from mlvalues.h)
+ - a pointer to the minor heap (Is_young)
+ - a pointer to the major heap (Is_in_heap)
+ - a pointer to a constant block statically-allocated by OCaml code
+ or the OCaml runtime (Is_in_static_data)
+ - a "foreign" pointer, which is none of the above; the destination
+ of those pointers may be a well-formed OCaml blocks, but it may
+ also be a naked pointer.
+
+ The macros and functions below give access to a global page table
+ to classify addresses to be able to implement Is_in_heap,
+ In_static_data (or their disjunction Is_in_value_area) and thus
+ detect values which may be naked pointers. The runtime
+ conservatively assumes that all foreign pointers may be naked
+ pointers, and uses the page table to not dereference/follow them.
+
+ In "no naked pointers" mode (when NO_NAKED_POINTERS is defined),
+ naked pointers are illegal, so pointers that are values can always
+ be assumed to point to well-formed blocks.
+
+ To support an implementation without a global page table, runtime
+ code should not rely on Is_in_heap and Is_in_static_data. This
+ corresponds to a simpler model where a valid value is either:
+ - a tagged integer (Is_long)
+ - a pointer to the minor heap (Is_young)
+ - a pointer to a well-formed block outside the minor heap
+ (it may be in the major heap, or static, or a foreign pointer,
+ without a check to distinguish the various cases).
+
+ (To create a well-formed block outside the heap that the GC will
+ not scan, one can use the Caml_out_of_heap_header from mlvalues.h.)
+*/
+
#ifndef CAML_ADDRESS_CLASS_H
#define CAML_ADDRESS_CLASS_H
#define Is_in_heap(a) (Classify_addr(a) & In_heap)
+#ifdef NO_NAKED_POINTERS
+
+#define Is_in_heap_or_young(a) 1
+#define Is_in_value_area(a) 1
+
+#else
+
#define Is_in_heap_or_young(a) (Classify_addr(a) & (In_heap | In_young))
#define Is_in_value_area(a) \
(Classify_addr(a) & (In_heap | In_young | In_static_data))
-#define Is_in_code_area(pc) \
- ( ((char *)(pc) >= caml_code_area_start && \
- (char *)(pc) <= caml_code_area_end) \
- || (Classify_addr(pc) & In_code_area) )
-
#define Is_in_static_data(a) (Classify_addr(a) & In_static_data)
+#endif
+
/***********************************************************************/
/* The rest of this file is private and may change without notice. */
-extern char * caml_code_area_start, * caml_code_area_end;
-
#define Not_in_heap 0
#define In_heap 1
#define In_young 2
#define In_static_data 4
-#define In_code_area 8
#ifdef ARCH_SIXTYFOUR
__attribute__ ((format (printf, 1, 2)))
#endif
;
-
-CAMLextern value caml_alloc_with_profinfo (mlsize_t, tag_t, intnat);
-CAMLextern value caml_alloc_small_with_my_or_given_profinfo (
- mlsize_t, tag_t, uintnat);
-CAMLextern value caml_alloc_small_with_profinfo (mlsize_t, tag_t, intnat);
+CAMLextern value caml_alloc_some(value);
typedef void (*final_fun)(value);
CAMLextern value caml_alloc_final (mlsize_t wosize,
* It might be called before GC initialization, so it shouldn't do OCaml
* allocation.
*/
-CAMLprim value caml_record_backtrace(value vflag);
+CAMLextern value caml_record_backtrace(value vflag);
#ifndef NATIVE_CODE
* different prototype. */
extern void caml_stash_backtrace(value exn, value * sp, int reraise);
+CAMLextern void caml_load_main_debug_info(void);
#endif
CAMLextern void caml_print_exception_backtrace(void);
void caml_init_backtrace(void);
-CAMLexport void caml_init_debug_info(void);
+CAMLextern void caml_init_debug_info(void);
#endif /* CAML_INTERNALS */
* Relevant for bytecode, always true for native code. */
int caml_debug_info_available(void);
+/* Check load status of debug information for the main program. This is always 1
+ * for native code. For bytecode, it is 1 if the debug information has been
+ * loaded, 0 if it has not been loaded or one of the error constants in
+ * startup.h if something went wrong loading the debug information. */
+int caml_debug_info_status(void);
+
/* Return debuginfo associated to a slot or NULL. */
debuginfo caml_debuginfo_extract(backtrace_slot slot);
#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 try_leave_blocking_section_hook caml_try_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
#endif
#endif
-#ifdef __MINGW32__
+#if defined(__MINGW32__) && !__USE_MINGW_ANSI_STDIO
#define ARCH_INT64_TYPE long long
#define ARCH_UINT64_TYPE unsigned long long
#define ARCH_INT64_PRINTF_FORMAT "I64"
as first-class values (GCC 2.x). */
#if defined(__GNUC__) && __GNUC__ >= 2 && !defined(DEBUG) \
- && !defined (SHRINKED_GNUC) && !defined(CAML_JIT)
+ && !defined (SHRINKED_GNUC)
#define THREADED_CODE
#endif
caml_final_custom_operations(void (*fn)(value));
extern void caml_init_custom_operations(void);
+
+extern struct custom_operations caml_nativeint_ops;
+extern struct custom_operations caml_int32_ops;
+extern struct custom_operations caml_int64_ops;
+extern struct custom_operations caml_ba_ops;
#endif /* CAML_INTERNALS */
#ifdef __cplusplus
void caml_debugger_init (void);
void caml_debugger (enum event_kind event, value param);
-void caml_debugger_cleanup_fork (void);
+CAMLextern void caml_debugger_cleanup_fork (void);
opcode_t caml_debugger_saved_instruction(code_t pc);
DOMAIN_STATE(struct caml_custom_table*, custom_table)
/* See minor_gc.c */
+DOMAIN_STATE(struct mark_stack*, mark_stack)
+/* See major_gc.c */
+
DOMAIN_STATE(value*, stack_low)
DOMAIN_STATE(value*, stack_high)
DOMAIN_STATE(value*, stack_threshold)
DOMAIN_STATE(intnat, stat_heap_wsz)
DOMAIN_STATE(intnat, stat_top_heap_wsz)
DOMAIN_STATE(intnat, stat_compactions)
+DOMAIN_STATE(intnat, stat_forced_major_collections)
DOMAIN_STATE(intnat, stat_heap_chunks)
/* See gc_ctrl.c */
DOMAIN_STATE(uintnat, eventlog_startup_timestamp)
-DOMAIN_STATE(uint32_t, eventlog_startup_pid)
+DOMAIN_STATE(long, eventlog_startup_pid)
DOMAIN_STATE(uintnat, eventlog_paused)
DOMAIN_STATE(uintnat, eventlog_enabled)
DOMAIN_STATE(FILE*, eventlog_out)
/* See eventlog.c */
+
+#if defined(NAKED_POINTERS_CHECKER) && !defined(_WIN32)
+DOMAIN_STATE(void*, checking_pointer_pc)
+/* See major_gc.c */
+#endif
/* Magic number for this release */
-#define EXEC_MAGIC "Caml1999X028"
+#define EXEC_MAGIC "Caml1999X029"
#endif /* CAML_INTERNALS */
int caml_is_special_exception(value exn);
-value caml_raise_if_exception(value res);
+CAMLextern value caml_raise_if_exception(value res);
#endif /* CAML_INTERNALS */
Make_header(wosize, tag, color)
#endif
-#ifdef WITH_SPACETIME
-struct ext_table;
-extern uintnat caml_spacetime_my_profinfo(struct ext_table**, uintnat);
-#define Make_header_allocated_here(wosize, tag, color) \
- (Make_header_with_profinfo(wosize, tag, color, \
- caml_spacetime_my_profinfo(NULL, wosize)) \
- )
-#else
-#define Make_header_allocated_here Make_header
-#endif
-
#define Is_white_val(val) (Color_val(val) == Caml_white)
-#define Is_gray_val(val) (Color_val(val) == Caml_gray)
#define Is_blue_val(val) (Color_val(val) == Caml_blue)
#define Is_black_val(val) (Color_val(val) == Caml_black)
APPTERM, APPTERM1, APPTERM2, APPTERM3,
RETURN, RESTART, GRAB,
CLOSURE, CLOSUREREC,
- OFFSETCLOSUREM2, OFFSETCLOSURE0, OFFSETCLOSURE2, OFFSETCLOSURE,
- PUSHOFFSETCLOSUREM2, PUSHOFFSETCLOSURE0,
- PUSHOFFSETCLOSURE2, PUSHOFFSETCLOSURE,
+ OFFSETCLOSUREM3, OFFSETCLOSURE0, OFFSETCLOSURE3, OFFSETCLOSURE,
+ PUSHOFFSETCLOSUREM3, PUSHOFFSETCLOSURE0,
+ PUSHOFFSETCLOSURE3, PUSHOFFSETCLOSURE,
GETGLOBAL, PUSHGETGLOBAL, GETGLOBALFIELD, PUSHGETGLOBALFIELD, SETGLOBAL,
ATOM0, ATOM, PUSHATOM0, PUSHATOM,
MAKEBLOCK, MAKEBLOCK1, MAKEBLOCK2, MAKEBLOCK3, MAKEFLOATBLOCK,
/* interpret a bytecode */
value caml_interprete (code_t prog, asize_t prog_size);
-/* tell the runtime that a bytecode program might be needed */
-void caml_prepare_bytecode(code_t prog, asize_t prog_size);
-
-/* tell the runtime that a bytecode program is no more needed */
-void caml_release_bytecode(code_t prog, asize_t prog_size);
-
#endif /* CAML_INTERNALS */
#endif /* CAML_INTERP_H */
#ifdef CAML_INTERNALS
value caml_input_val (struct channel * chan);
/* Read a structured value from the channel [chan]. */
-
-extern value caml_input_value_to_outside_heap (value channel);
- /* As for [caml_input_value], but the value is unmarshalled into
- malloc blocks that are not added to the heap. Not for the
- casual user. */
-
-extern int caml_extern_allow_out_of_heap;
- /* Permit the marshaller to traverse structures that look like OCaml
- values but do not live in the OCaml heap. */
-
-extern value caml_output_value(value vchan, value v, value flags);
#endif /* CAML_INTERNALS */
CAMLextern value caml_input_val_from_string (value str, intnat ofs);
enum {
CHANNEL_FLAG_FROM_SOCKET = 1, /* For Windows */
-#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
- CHANNEL_FLAG_BLOCKING_WRITE = 2, /* Don't release master lock when writing */
-#endif
CHANNEL_FLAG_MANAGED_BY_GC = 4, /* Free and close using GC finalization */
+ CHANNEL_TEXT_MODE = 8, /* "Text mode" for Windows and Cygwin */
};
/* For an output channel:
[offset] is the absolute position of the logical end of the buffer, [max].
*/
-/* Functions and macros that can be called from C. Take arguments of
- type struct channel *. No locking is performed. */
+/* Creating and closing channels from C */
+
+CAMLextern struct channel * caml_open_descriptor_in (int);
+CAMLextern struct channel * caml_open_descriptor_out (int);
+CAMLextern void caml_close_channel (struct channel *);
+CAMLextern file_offset caml_channel_size (struct channel *);
+CAMLextern void caml_seek_in (struct channel *, file_offset);
+CAMLextern void caml_seek_out (struct channel *, file_offset);
+CAMLextern file_offset caml_pos_in (struct channel *);
+CAMLextern file_offset caml_pos_out (struct channel *);
+
+/* I/O on channels from C. The channel must be locked (see below) before
+ calling any of the functions and macros below */
#define caml_putch(channel, ch) do{ \
if ((channel)->curr >= (channel)->end) caml_flush_partial(channel); \
? caml_refill(channel) \
: (unsigned char) *((channel)->curr)++)
-CAMLextern struct channel * caml_open_descriptor_in (int);
-CAMLextern struct channel * caml_open_descriptor_out (int);
-CAMLextern void caml_close_channel (struct channel *);
-CAMLextern int caml_channel_binary_mode (struct channel *);
CAMLextern value caml_alloc_channel(struct channel *chan);
+CAMLextern int caml_channel_binary_mode (struct channel *);
CAMLextern int caml_flush_partial (struct channel *);
CAMLextern void caml_flush (struct channel *);
#define Val_file_offset(fofs) caml_copy_int64(fofs)
#define File_offset_val(v) ((file_offset) Int64_val(v))
+/* Primitives required by the Unix library */
+CAMLextern value caml_ml_open_descriptor_in(value fd);
+CAMLextern value caml_ml_open_descriptor_out(value fd);
+
#endif /* CAML_INTERNALS */
#endif /* CAML_IO_H */
#undef PROFINFO_WIDTH
-#undef WITH_SPACETIME
-#undef ENABLE_CALL_COUNTS
-
#undef ASM_CFI_SUPPORTED
#undef WITH_FRAME_POINTERS
#undef NO_NAKED_POINTERS
+#undef NAKED_POINTERS_CHECKER
+
#undef WITH_PROFINFO
#undef CAML_WITH_FPIC
#undef FUNCTION_SECTIONS
#undef SUPPORTS_ALIGNED_ATTRIBUTE
+
+#undef SUPPORTS_TREE_VECTORIZE
asize_t alloc; /* 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 */
} 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
extern int caml_gc_phase;
extern int caml_gc_subphase;
asize_t caml_clip_heap_chunk_wsz (asize_t wsz);
void caml_darken (value, value *);
void caml_major_collection_slice (intnat);
+void caml_shrink_mark_stack ();
void major_collection (void);
void caml_finish_major_cycle (void);
void caml_set_major_window (int);
CAMLextern void caml_modify (value *, value);
CAMLextern void caml_initialize (value *, value);
CAMLextern value caml_check_urgent_gc (value);
+CAMLextern color_t caml_allocation_color (void *hp);
+#ifdef CAML_INTERNALS
CAMLextern char *caml_alloc_for_heap (asize_t request); /* Size in bytes. */
CAMLextern void caml_free_for_heap (char *mem);
-CAMLextern void caml_disown_for_heap (char *mem);
CAMLextern int caml_add_to_heap (char *mem);
-CAMLextern color_t caml_allocation_color (void *hp);
+#endif /* CAML_INTERNALS */
CAMLextern int caml_huge_fallback_count;
#define Alloc_small_with_profinfo(result, wosize, tag, profinfo) \
Alloc_small_aux(result, wosize, tag, profinfo, CAML_DO_TRACK)
-#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
-
-extern uintnat caml_spacetime_my_profinfo(struct ext_table**, uintnat);
-
-#define Alloc_small(result, wosize, tag) \
- Alloc_small_with_profinfo(result, wosize, tag, \
- caml_spacetime_my_profinfo(NULL, wosize))
-#define Alloc_small_no_track(result, wosize, tag) \
- Alloc_small_aux(result, wosize, tag, \
- caml_spacetime_my_profinfo(NULL, wosize), CAML_DONT_TRACK)
-
-#else
-
#define Alloc_small(result, wosize, tag) \
Alloc_small_with_profinfo(result, wosize, tag, (uintnat) 0)
#define Alloc_small_no_track(result, wosize, tag) \
Alloc_small_aux(result, wosize, tag, (uintnat) 0, CAML_DONT_TRACK)
-#endif
-
/* Deprecated alias for [caml_modify] */
#define Modify(fp,val) caml_modify((fp), (val))
#include "mlvalues.h"
#include "roots.h"
-extern int caml_memprof_suspended;
+extern void caml_memprof_set_suspended(int);
extern value caml_memprof_handle_postponed_exn(void);
extern void caml_memprof_track_alloc_shr(value block);
+extern void caml_memprof_track_custom(value block, mlsize_t bytes);
extern void caml_memprof_track_young(uintnat wosize, int from_caml,
int nallocs, unsigned char* alloc_lens);
extern void caml_memprof_track_interned(header_t* block, header_t* blockend);
extern void caml_memprof_update_clean_phase(void);
extern void caml_memprof_invert_tracked(void);
-extern void caml_memprof_shutdown(void);
+CAMLextern struct caml_memprof_th_ctx caml_memprof_main_ctx;
-struct caml_memprof_th_ctx {
- int suspended, callback_running;
-};
-extern void caml_memprof_init_th_ctx(struct caml_memprof_th_ctx* ctx);
-extern void caml_memprof_stop_th_ctx(struct caml_memprof_th_ctx* ctx);
-extern void caml_memprof_save_th_ctx(struct caml_memprof_th_ctx* ctx);
-extern void caml_memprof_restore_th_ctx(const struct caml_memprof_th_ctx* ctx);
+CAMLextern struct caml_memprof_th_ctx* caml_memprof_new_th_ctx(void);
+CAMLextern void caml_memprof_leave_thread(void);
+CAMLextern void caml_memprof_enter_thread(struct caml_memprof_th_ctx*);
+CAMLextern void caml_memprof_delete_th_ctx(struct caml_memprof_th_ctx*);
+
+typedef void (*th_ctx_action)(struct caml_memprof_th_ctx*, void*);
+extern void (*caml_memprof_th_ctx_iter_hook)(th_ctx_action, void*);
#endif
/* Table of custom blocks in the minor heap that contain finalizers
or GC speed parameters. */
+CAMLextern void caml_minor_collection (void);
+
+#ifdef CAML_INTERNALS
extern void caml_set_minor_heap_size (asize_t); /* size in bytes */
extern void caml_empty_minor_heap (void);
-CAMLextern void caml_gc_dispatch (void);
-CAMLextern void caml_minor_collection (void);
-CAMLextern void garbage_collection (void); /* runtime/signals_nat.c */
+extern void caml_gc_dispatch (void);
+extern void caml_garbage_collection (void); /* runtime/signals_nat.c */
extern void caml_oldify_one (value, value *);
extern void caml_oldify_mopup (void);
elt->max = max;
}
+#endif /* CAML_INTERNALS */
+
#endif /* CAML_MINOR_GC_H */
#define Noreturn
#endif
-
-
/* Export control (to mark primitives and to handle Windows DLL) */
+#ifndef CAMLDLLIMPORT
+ #if defined(SUPPORT_DYNAMIC_LINKING) && defined(ARCH_SIXTYFOUR) \
+ && defined(__CYGWIN__)
+ #define CAMLDLLIMPORT __declspec(dllimport)
+ #else
+ #define CAMLDLLIMPORT
+ #endif
+#endif
+
#define CAMLexport
#define CAMLprim
-#define CAMLextern extern
+#define CAMLextern CAMLDLLIMPORT extern
/* Weak function definitions that can be overridden by external libs */
/* Conservatively restricted to ELF and MacOSX platforms */
#define unlink_os _wunlink
#define rename_os caml_win32_rename
#define chdir_os _wchdir
+#define mkdir_os(path, perm) _wmkdir(path)
#define getcwd_os _wgetcwd
#define system_os _wsystem
#define rmdir_os _wrmdir
#define unlink_os unlink
#define rename_os rename
#define chdir_os chdir
+#define mkdir_os mkdir
#define getcwd_os getcwd
#define system_os system
#define rmdir_os rmdir
extern void caml_ext_table_free(struct ext_table * tbl, int free_entries);
extern void caml_ext_table_clear(struct ext_table * tbl, int free_entries);
+/* Add to [contents] the (short) names of the files contained in
+ the directory named [dirname]. No entries are added for [.] and [..].
+ Return 0 on success, -1 on error; set errno in the case of error. */
CAMLextern int caml_read_directory(char_os * dirname,
struct ext_table * contents);
/* If tag == Infix_tag : an infix header inside a closure */
/* Infix_tag must be odd so that the infix header is scanned as an integer */
-/* Infix_tag must be 1 modulo 4 and infix headers can only occur in blocks
+/* Infix_tag must be 1 modulo 2 and infix headers can only occur in blocks
with tag Closure_tag (see compact.c). */
#define Infix_tag 249
/* Special case of tuples of fields: closures */
#define Closure_tag 247
#define Code_val(val) (((code_t *) (val)) [0]) /* Also an l-value. */
+#define Closinfo_val(val) Field((val), 1) /* Arity and start env */
+/* In the closure info field, the top 8 bits are the arity (signed).
+ The low bit is set to one, to look like an integer.
+ The remaining bits are the field number for the first word of the
+ environment, or, in other words, the offset (in words) from the closure
+ to the environment part. */
+#ifdef ARCH_SIXTYFOUR
+#define Arity_closinfo(info) ((intnat)(info) >> 56)
+#define Start_env_closinfo(info) (((uintnat)(info) << 8) >> 9)
+#define Make_closinfo(arity,delta) \
+ (((uintnat)(arity) << 56) + ((uintnat)(delta) << 1) + 1)
+#else
+#define Arity_closinfo(info) ((intnat)(info) >> 24)
+#define Start_env_closinfo(info) (((uintnat)(info) << 8) >> 9)
+#define Make_closinfo(arity,delta) \
+ (((uintnat)(arity) << 24) + ((uintnat)(delta) << 1) + 1)
+#endif
/* This tag is used (with Forward_tag) to implement lazy values.
See major_gc.c and stdlib/lazy.ml. */
#define Val_emptylist Val_int(0)
#define Tag_cons 0
+/* Option constructors */
+
+#define Val_none Val_int(0)
+#define Some_val(v) Field(v, 0)
+#define Tag_some 0
+#define Is_none(v) ((v) == Val_none)
+#define Is_some(v) Is_block(v)
+
/* The table of global identifiers */
extern value caml_global_data;
CAMLextern value caml_set_oo_id(value obj);
+/* Header for out-of-heap blocks. */
+
+#define Caml_out_of_heap_header(wosize, tag) \
+ (/*CAMLassert ((wosize) <= Max_wosize),*/ \
+ ((header_t) (((header_t) (wosize) << 10) \
+ + (3 << 8) /* matches [Caml_black]. See [gc.h] */ \
+ + (tag_t) (tag))) \
+ )
+
#ifdef __cplusplus
}
#endif
#include "misc.h"
#include "memory.h"
+#define Io_interrupted (-1)
+
/* Read at most [n] bytes from file descriptor [fd] into buffer [buf].
[flags] indicates whether [fd] is a socket
(bit [CHANNEL_FLAG_FROM_SOCKET] is set in this case, see [io.h]).
(This distinction matters for Win32, but not for Unix.)
Return number of bytes read.
- In case of error, raises [Sys_error] or [Sys_blocked_io]. */
+ In case of error, raises [Sys_error] or [Sys_blocked_io].
+ If interrupted by a signal and no bytes where read, returns
+ Io_interrupted without raising. */
extern int caml_read_fd(int fd, int flags, void * buf, int n);
/* Write at most [n] bytes from buffer [buf] onto file descriptor [fd].
(bit [CHANNEL_FLAG_FROM_SOCKET] is set in this case, see [io.h]).
(This distinction matters for Win32, but not for Unix.)
Return number of bytes written.
- In case of error, raises [Sys_error] or [Sys_blocked_io]. */
+ In case of error, raises [Sys_error] or [Sys_blocked_io].
+ If interrupted by a signal and no bytes were written, returns
+ Io_interrupted without raising. */
extern int caml_write_fd(int fd, int flags, void * buf, int n);
/* Decompose the given path into a list of directories, and add them
/* Return an error message describing the most recent dynlink failure. */
extern char * caml_dlerror(void);
-/* Add to [contents] the (short) names of the files contained in
- the directory named [dirname]. No entries are added for [.] and [..].
- Return 0 on success, -1 on error; set errno in the case of error. */
-extern int caml_read_directory(char_os * dirname, struct ext_table * contents);
-
/* Recover executable name if possible (/proc/sef/exe under Linux,
GetModuleFileName under Windows). Return NULL on error,
string allocated with [caml_stat_alloc] on success. */
/* Windows Unicode support */
-extern int win_multi_byte_to_wide_char(const char* s,
+CAMLextern int win_multi_byte_to_wide_char(const char* s,
int slen,
wchar_t *out,
int outlen);
-extern int win_wide_char_to_multi_byte(const wchar_t* s,
+CAMLextern int win_wide_char_to_multi_byte(const wchar_t* s,
int slen,
char *out,
int outlen);
The returned string is allocated with [caml_stat_alloc], so it should be free
using [caml_stat_free].
*/
-extern wchar_t* caml_stat_strdup_to_utf16(const char *s);
+CAMLextern wchar_t* caml_stat_strdup_to_utf16(const char *s);
/* [caml_stat_strdup_of_utf16(s)] returns a NULL-terminated copy of [s],
re-encoded in UTF-8 if [caml_windows_unicode_runtime_enabled] is non-zero or
The returned string is allocated with [caml_stat_alloc], so it should be free
using [caml_stat_free].
*/
-extern char* caml_stat_strdup_of_utf16(const wchar_t *s);
+CAMLextern char* caml_stat_strdup_of_utf16(const wchar_t *s);
/* [caml_copy_string_of_utf16(s)] returns an OCaml string containing a copy of
[s] re-encoded in UTF-8 if [caml_windows_unicode_runtime_enabled] is non-zero
or in the current code page otherwise.
*/
-extern value caml_copy_string_of_utf16(const wchar_t *s);
+CAMLextern value caml_copy_string_of_utf16(const wchar_t *s);
+
+CAMLextern int caml_win32_isatty(int fd);
-extern int caml_win32_isatty(int fd);
+CAMLextern void caml_expand_command_line (int *, wchar_t ***);
#endif /* _WIN32 */
CAMLextern char * caml_format_exception (value);
+#ifdef CAML_INTERNALS
CAMLnoreturn_start void caml_fatal_uncaught_exception (value) CAMLnoreturn_end;
+#endif /* CAML_INTERNALS */
#ifdef __cplusplus
}
void caml_do_roots (scanning_action, int);
extern uintnat caml_incremental_roots_count;
#ifndef NATIVE_CODE
-CAMLextern void caml_do_local_roots (scanning_action, value *, value *,
- struct caml__roots_block *);
+CAMLextern void caml_do_local_roots_byt (scanning_action, value *, value *,
+ struct caml__roots_block *);
+#define caml_do_local_roots caml_do_local_roots_byt
#else
-CAMLextern void caml_do_local_roots(scanning_action f, char * c_bottom_of_stack,
- uintnat last_retaddr, value * v_gc_regs,
- struct caml__roots_block * gc_local_roots);
+CAMLextern void caml_do_local_roots_nat (
+ scanning_action f, char * c_bottom_of_stack,
+ uintnat last_retaddr, value * v_gc_regs,
+ struct caml__roots_block * gc_local_roots);
+#define caml_do_local_roots caml_do_local_roots_nat
#endif
CAMLextern void (*caml_scan_roots_hook) (scanning_action);
/* Define HAS_GETCWD if the library provides the getcwd() function. */
+#undef HAS_SYSTEM
+
+/* Define HAS_SYSTEM if the library provides the system() function. */
+
#undef HAS_UTIME
#undef HAS_UTIMES
#undef HAS_SYS_SHM_H
+#undef HAS_SHMAT
+
#undef HAS_EXECVPE
+#undef HAS_POSIX_SPAWN
+
#undef HAS_FFS
#undef HAS_BITSCANFORWARD
#undef HAS_SIGWAIT
-#undef HAS_LIBBFD
-
#undef HAS_HUGE_PAGES
#undef HUGE_PAGE_SIZE
-#undef HAS_LIBUNWIND
-
#undef HAS_BROKEN_PRINTF
#undef HAS_STRERROR
#endif
CAMLextern void caml_enter_blocking_section (void);
+CAMLextern void caml_enter_blocking_section_no_pending (void);
CAMLextern void caml_leave_blocking_section (void);
CAMLextern void caml_process_pending_actions (void);
Memprof callbacks. Assumes that the runtime lock is held. Can raise
exceptions asynchronously into OCaml code. */
+CAMLextern int caml_check_pending_actions (void);
+/* Returns 1 if there are pending actions, 0 otherwise. */
+
CAMLextern value caml_process_pending_actions_exn (void);
/* Same as [caml_process_pending_actions], but returns the exception
if any (otherwise returns [Val_unit]). */
CAMLextern int caml_convert_signal_number (int);
CAMLextern int caml_rev_convert_signal_number (int);
value caml_execute_signal_exn(int signal_number, int in_signal_handler);
-void caml_record_signal(int signal_number);
-value caml_process_pending_signals_exn(void);
+CAMLextern void caml_record_signal(int signal_number);
+CAMLextern value caml_process_pending_signals_exn(void);
void caml_set_action_pending (void);
value caml_do_pending_actions_exn (void);
value caml_process_pending_actions_with_root (value extra_root); // raises
+value caml_process_pending_actions_with_root_exn (value extra_root);
int caml_set_signal_action(int signo, int action);
-void caml_setup_stack_overflow_detection(void);
+CAMLextern void caml_setup_stack_overflow_detection(void);
CAMLextern void (*caml_enter_blocking_section_hook)(void);
CAMLextern void (*caml_leave_blocking_section_hook)(void);
-CAMLextern int (*caml_try_leave_blocking_section_hook)(void);
#ifdef POSIX_SIGNALS
CAMLextern int (*caml_sigmask_hook)(int, const sigset_t *, sigset_t *);
#endif
+++ /dev/null
-/**************************************************************************/
-/* */
-/* OCaml */
-/* */
-/* Mark Shinwell and Leo White, Jane Street Europe */
-/* */
-/* Copyright 2013--2016, Jane Street Group, LLC */
-/* */
-/* All rights reserved. This file is distributed under the terms of */
-/* the GNU Lesser General Public License version 2.1, with the */
-/* special exception on linking described in the file LICENSE. */
-/* */
-/**************************************************************************/
-
-#ifndef CAML_SPACETIME_H
-#define CAML_SPACETIME_H
-
-#include "io.h"
-#include "misc.h"
-#include "stack.h"
-
-/* Runtime support for Spacetime profiling.
- * This header file is not intended for the casual user.
- *
- * The implementation is split into three files:
- * 1. spacetime.c: core management of the instrumentation;
- * 2. spacetime_snapshot.c: the taking of heap snapshots;
- * 3. spacetime_offline.c: functions that are also used when examining
- * saved profiling data.
- */
-
-typedef enum {
- CALL,
- ALLOCATION
-} c_node_type;
-
-/* All pointers between nodes point at the word immediately after the
- GC headers, and everything is traversable using the normal OCaml rules.
-
- On entry to an OCaml function:
- If the node hole pointer register has the bottom bit set, then the function
- is being tail called or called from a self-recursive call site:
- - If the node hole is empty, the callee must create a new node and link
- it into the tail chain. The node hole pointer will point at the tail
- chain.
- - Otherwise the node should be used as normal.
- Otherwise (not a tail call):
- - If the node hole is empty, the callee must create a new node, but the
- tail chain is untouched.
- - Otherwise the node should be used as normal.
-*/
-
-/* Classification of nodes (OCaml or C) with corresponding GC tags. */
-#define OCaml_node_tag 0
-#define C_node_tag 1
-#define Is_ocaml_node(node) (Is_block(node) && Tag_val(node) == OCaml_node_tag)
-#define Is_c_node(node) (Is_block(node) && Tag_val(node) == C_node_tag)
-
-/* The header words are:
- 1. The node program counter.
- 2. The tail link. */
-#define Node_num_header_words 2
-
-/* The "node program counter" at the start of an OCaml node. */
-#define Node_pc(node) (Field(node, 0))
-#define Encode_node_pc(pc) (((value) pc) | 1)
-#define Decode_node_pc(encoded_pc) ((void*) (encoded_pc & ~1))
-
-/* The circular linked list of tail-called functions within OCaml nodes. */
-#define Tail_link(node) (Field(node, 1))
-
-/* The convention for pointers from OCaml nodes to other nodes. There are
- two special cases:
- 1. [Val_unit] means "uninitialized", and further, that this is not a
- tail call point. (Tail call points are pre-initialized, as in case 2.)
- 2. If the bottom bit is set, and the value is not [Val_unit], this is a
- tail call point. */
-#define Encode_tail_caller_node(node) ((node) | 1)
-#define Decode_tail_caller_node(node) ((node) & ~1)
-#define Is_tail_caller_node_encoded(node) (((node) & 1) == 1)
-
-/* Allocation points within OCaml nodes.
- The "profinfo" value looks exactly like a black Infix_tag header.
- This enables us to point just after it and return such pointer as a valid
- OCaml value. (Used for the list of all allocation points. We could do
- without this and instead just encode the list pointers as integers, but
- this would mean that the structure was destroyed on marshalling. This
- might not be a great problem since it is intended that the total counts
- be obtained via snapshots, but it seems neater and easier to use
- Infix_tag.
- The "count" is just an OCaml integer giving the total number of words
- (including headers) allocated at the point.
- The "pointer to next allocation point" points to the "count" word of the
- next allocation point in the linked list of all allocation points.
- There is no special encoding needed by virtue of the [Infix_tag] trick. */
-#define Alloc_point_profinfo(node, offset) (Field(node, offset))
-#define Alloc_point_count(node, offset) (Field(node, offset + 1))
-#define Alloc_point_next_ptr(node, offset) (Field(node, offset + 2))
-
-/* Direct call points (tail or non-tail) within OCaml nodes.
- They hold a pointer to the child node and (if the compiler was so
- configured) a call count.
- The call site and callee are both recorded in the shape. */
-#define Direct_callee_node(node,offset) (Field(node, offset))
-#define Direct_call_count(node,offset) (Field(node, offset + 1))
-#define Encode_call_point_pc(pc) (((value) pc) | 1)
-#define Decode_call_point_pc(pc) ((void*) (((value) pc) & ~((uintnat) 1)))
-
-/* Indirect call points (tail or non-tail) within OCaml nodes.
- They hold a linked list of (PC upon entry to the callee, pointer to
- child node) pairs. The linked list is encoded using C nodes and should
- be thought of as part of the OCaml node itself. */
-#define Indirect_num_fields 1
-#define Indirect_pc_linked_list(node,offset) (Field(node, offset))
-
-/* Encodings of the program counter value within a C node. */
-#define Encode_c_node_pc_for_call(pc) ((((value) pc) << 2) | 3)
-#define Encode_c_node_pc_for_alloc_point(pc) ((((value) pc) << 2) | 1)
-#define Decode_c_node_pc(pc) ((void*) (((uintnat) (pc)) >> 2))
-
-typedef struct {
- /* The layout and encoding of this structure must match that of the
- allocation points within OCaml nodes, so that the linked list
- traversal across all allocation points works correctly. */
- value profinfo; /* encoded using [Infix_tag] (see above) */
- value count;
- /* [next] is [Val_unit] for the end of the list.
- Otherwise it points at the second word of this [allocation_point]
- structure. */
- value next;
-} allocation_point;
-
-typedef struct {
- value callee_node;
- value call_count;
-} call_point;
-
-typedef struct {
- /* CR-soon mshinwell: delete [gc_header], all the offset arithmetic will
- then go away */
- uintnat gc_header;
- uintnat pc; /* see above for encodings */
- union {
- call_point call; /* for CALL */
- allocation_point allocation; /* for ALLOCATION */
- } data;
- value next; /* [Val_unit] for the end of the list */
-} c_node; /* CR-soon mshinwell: rename to dynamic_node */
-
-typedef struct shape_table {
- uint64_t* table;
- struct shape_table* next;
-} shape_table;
-
-extern uint64_t** caml_spacetime_static_shape_tables;
-extern shape_table* caml_spacetime_dynamic_shape_tables;
-
-typedef struct ext_table* spacetime_unwind_info_cache;
-
-extern value caml_spacetime_trie_root;
-extern value* caml_spacetime_trie_node_ptr;
-extern value* caml_spacetime_finaliser_trie_root;
-
-extern allocation_point* caml_all_allocation_points;
-
-extern void caml_spacetime_initialize(void);
-extern uintnat caml_spacetime_my_profinfo(
- spacetime_unwind_info_cache*, uintnat);
-extern c_node_type caml_spacetime_classify_c_node(c_node* node);
-extern c_node* caml_spacetime_c_node_of_stored_pointer(value);
-extern c_node* caml_spacetime_c_node_of_stored_pointer_not_null(value);
-extern value caml_spacetime_stored_pointer_of_c_node(c_node* node);
-extern void caml_spacetime_register_thread(value*, value*);
-extern void caml_spacetime_register_shapes(void*);
-extern value caml_spacetime_frame_table(void);
-extern value caml_spacetime_shape_table(void);
-extern void caml_spacetime_save_snapshot (struct channel *chan,
- double time_override,
- int use_time_override);
-extern value caml_spacetime_timestamp(double time_override,
- int use_time_override);
-extern void caml_spacetime_automatic_snapshot (void);
-
-/* For use in runtime functions that are executed from OCaml
- code, to save the overhead of using libunwind every time. */
-#ifdef WITH_SPACETIME
-#define Get_my_profinfo_with_cached_backtrace(profinfo, size) \
- do { \
- static spacetime_unwind_info_cache spacetime_unwind_info = NULL; \
- profinfo = caml_spacetime_my_profinfo(&spacetime_unwind_info, size); \
- } \
- while (0);
-#else
-#define Get_my_profinfo_with_cached_backtrace(profinfo, size) \
- profinfo = (uintnat) 0;
-#endif
-
-#else
-
-#define Get_my_profinfo_with_cached_backtrace(profinfo, size) \
- profinfo = (uintnat) 0;
-
-#endif
char * bottom_of_stack; /* beginning of OCaml stack chunk */
uintnat last_retaddr; /* last return address in OCaml code */
value * gc_regs; /* pointer to register block */
-#ifdef WITH_SPACETIME
- void* trie_node;
-#endif
};
/* Structure of frame descriptors */
#define caml_trap_barrier (Caml_state_field(trap_barrier))
#define Trap_pc(tp) (((code_t *)(tp))[0])
-#define Trap_link(tp) (((value **)(tp))[1])
+#define Trap_link_offset(tp) (((value *)(tp))[1])
void caml_init_stack (uintnat init_max_size);
void caml_realloc_stack (asize_t required_size);
#include "mlvalues.h"
#include "exec.h"
-CAMLextern void caml_main(char_os **argv);
-
CAMLextern void caml_startup_code(
code_t code, asize_t code_size,
char *data, asize_t data_size,
int pooling,
char_os **argv);
-enum { FILE_NOT_FOUND = -1, BAD_BYTECODE = -2, WRONG_MAGIC = -3 };
+/* These enum members should all be negative */
+enum { FILE_NOT_FOUND = -1, BAD_BYTECODE = -2, WRONG_MAGIC = -3, NO_FDS = -4 };
extern int caml_attempt_open(char_os **name, struct exec_trailer *trail,
int do_open_script);
CAMLextern value caml_sys_exit (value)
CAMLnoreturn_end;
-extern double caml_sys_time_unboxed(value);
CAMLextern value caml_sys_get_argv(value unit);
extern char_os * caml_exe_name;
child = Field (v, i);
ephemeron_again:
if (child != caml_ephe_none
- && Is_block (child) && Is_in_heap_or_young (child)){
+ && Is_block (child) && Is_in_value_area (child)){
if (Tag_val (child) == Forward_tag){
value f = Forward_val (child);
if (Is_block (f)) {
}
}
}
+ if (Tag_val (child) == Infix_tag) child -= Infix_offset_val (child);
if (Is_white_val (child) && !Is_young (child)){
release_data = 1;
Field (v, i) = caml_ephe_none;
child = Field (v, 1);
if(child != caml_ephe_none){
- if (release_data){
- Field (v, 1) = caml_ephe_none;
- } else {
- /* If we scanned all the keys and the data field remains filled,
- then the mark phase must have marked it */
- CAMLassert( !(offset_start == 2 && offset_end == Wosize_hd (Hd_val(v))
- && Is_block (child) && Is_in_heap (child)
- && Is_white_val (child)));
- }
+ if (release_data) Field (v, 1) = caml_ephe_none;
+#ifdef DEBUG
+ else if (offset_start == 2 && offset_end == Wosize_hd (Hd_val(v)) &&
+ Is_block (child) && Is_in_heap (child)) {
+ if (Tag_val (child) == Infix_tag) child -= Infix_offset_val (child);
+ /* If we scanned all the keys and the data field remains filled,
+ then the mark phase must have marked it */
+ CAMLassert( !Is_white_val (child) );
+ }
+#endif
}
}
extern uintnat caml_percent_free; /* major_gc.c */
extern void caml_shrink_heap (char *); /* memory.c */
-/* Encoded headers: the color is stored in the 2 least significant bits.
- (For pointer inversion, we need to distinguish headers from pointers.)
- s is a Wosize, t is a tag, and c is a color (a two-bit number)
-
- For the purpose of compaction, "colors" are:
- 0: pointers (direct or inverted)
- 1: integer or (unencoded) infix header
- 2: inverted pointer for infix header
- 3: integer or encoded (noninfix) header
-
- XXX Should be fixed:
- XXX The above assumes that all roots are aligned on a 4-byte boundary,
- XXX which is not always guaranteed by C.
- XXX (see [caml_register_global_roots])
- XXX Should be able to fix it to only assume 2-byte alignment.
+/* Colors
+
+ We use the GC's color bits in the following way:
+
+ - White words are headers of live blocks.
+ - Blue words are headers of free blocks.
+ - Black words are headers of out-of-heap "blocks".
+ - Gray words are the encoding of pointers in inverted lists.
+
+ Encoded pointers:
+ Pointers always have their two low-order bits clear. We make use of
+ this to encode pointers by shifting bits 2-9 to 0-7:
+ ...XXXyyyyyyyy00 becomes ...XXX01yyyyyyyy
+ Note that 01 corresponds to the "gray" color of the GC, so we can now
+ mix pointers and headers because there are no gray headers anywhere in
+ the heap (or outside) when we start a compaction (which must be done at
+ the end of a sweep phase).
*/
-#ifdef WITH_PROFINFO
-#define Make_ehd(s,t,c,p) \
- (((s) << 10) | (t) << 2 | (c) | ((p) << PROFINFO_SHIFT))
-#else
-#define Make_ehd(s,t,c,p) (((s) << 10) | (t) << 2 | (c))
-#endif
-#define Whsize_ehd(h) Whsize_hd (h)
-#define Wosize_ehd(h) Wosize_hd (h)
-#define Tag_ehd(h) (((h) >> 2) & 0xFF)
-#ifdef WITH_PROFINFO
-#define Profinfo_ehd(hd) Profinfo_hd(hd)
-#endif
-#define Ecolor(w) ((w) & 3)
typedef uintnat word;
+#define eptr(p) \
+ (((word) (p) & ~0x3FF) | ((((word) p) & 0x3FF) >> 2) | Caml_gray)
+#define dptr(p) ((word *) (((word) (p) & ~0x3FF) | ((((word) p) & 0xFF) << 2)))
+
static void invert_pointer_at (word *p)
{
word q = *p;
- CAMLassert (Ecolor ((intnat) p) == 0);
-
- /* Use Ecolor (q) == 0 instead of Is_block (q) because q could be an
- inverted pointer for an infix header (with Ecolor == 2). */
- if (Ecolor (q) == 0 && Is_in_heap (q)){
- switch (Ecolor (Hd_val (q))){
- case 0:
- case 3: /* Pointer or header: insert in inverted list. */
- *p = Hd_val (q);
- Hd_val (q) = (header_t) p;
- break;
- case 1: /* Infix header: make inverted infix list. */
- /* Double inversion: the last of the inverted infix list points to
- the next infix header in this block. The last of the last list
- contains the original block header. */
- {
- /* This block as a value. */
- value val = (value) q - Infix_offset_val (q);
- /* Get the block header. */
- word *hp = (word *) Hp_val (val);
-
- while (Ecolor (*hp) == 0) hp = (word *) *hp;
- CAMLassert (Ecolor (*hp) == 3);
- if (Tag_ehd (*hp) == Closure_tag){
- /* This is the first infix found in this block. */
- /* Save original header. */
- *p = *hp;
- /* Link inverted infix list. */
- Hd_val (q) = (header_t) ((word) p | 2);
- /* Change block header's tag to Infix_tag, and change its size
- to point to the infix list. */
- *hp = Make_ehd (Wosize_bhsize (q - val), Infix_tag, 3, (uintnat) 0);
- }else{
- CAMLassert (Tag_ehd (*hp) == Infix_tag);
- /* Point the last of this infix list to the current first infix
- list of the block. */
- *p = (word) &Field (val, Wosize_ehd (*hp)) | 1;
- /* Point the head of this infix list to the above. */
- Hd_val (q) = (header_t) ((word) p | 2);
- /* Change block header's size to point to this infix list. */
- *hp = Make_ehd (Wosize_bhsize (q - val), Infix_tag, 3, (uintnat) 0);
- }
+ header_t h;
+
+ CAMLassert (((uintnat) p & 3) == 0);
+
+ if (Is_block (q) && Is_in_value_area (q)){
+ h = Hd_val (q);
+ switch (Color_hd (h)){
+ case Caml_white:
+ if (Tag_hd (h) == Infix_tag){
+ value realvalue = (value) q - Infix_offset_val (q);
+ if (Is_black_val (realvalue)) break;
}
+ /* FALL THROUGH */
+ case Caml_gray:
+ CAMLassert (Is_in_heap (q));
+ /* [q] points to some inverted list, insert it. */
+ *p = h;
+ Hd_val (q) = eptr (p);
break;
- case 2: /* Inverted infix list: insert. */
- *p = Hd_val (q);
- Hd_val (q) = (header_t) ((word) p | 2);
+ case Caml_black:
+ /* [q] points to an out-of-heap value. Leave it alone. */
+ break;
+ default: /* Caml_blue */
+ /* We found a pointer to a free block. This cannot happen. */
+ CAMLassert (0);
break;
}
}
void caml_invert_root (value v, value *p)
{
+#ifdef NO_NAKED_POINTERS
+ /* Note: this assertion will become tautological and should be removed when
+ we finally get rid of the page table in NNP mode.
+ */
+ CAMLassert (Is_long (*p) || Is_in_heap (*p) || Is_black_val (*p)
+ || Tag_val (*p) == Infix_tag);
+#endif
invert_pointer_at ((word *) p);
}
*/
caml_fl_reset_and_switch_policy (new_allocation_policy);
-
- /* First pass: encode all noninfix headers. */
- {
- ch = caml_heap_start;
- while (ch != NULL){
- header_t *p = (header_t *) ch;
-
- chend = ch + Chunk_size (ch);
- while ((char *) p < chend){
- header_t hd = Hd_hp (p);
- mlsize_t sz = Wosize_hd (hd);
-
- if (Is_blue_hd (hd)){
- /* Free object. Give it a string tag. */
- Hd_hp (p) = Make_ehd (sz, String_tag, 3, (uintnat) 0);
- }else{
- CAMLassert (Is_white_hd (hd));
- /* Live object. Keep its tag. */
- Hd_hp (p) = Make_ehd (sz, Tag_hd (hd), 3, Profinfo_hd (hd));
- }
- p += Whsize_wosize (sz);
- }
- ch = Chunk_next (ch);
- }
- }
+ /* First pass: removed in 4.12 thanks to the new closure representation. */
/* Second pass: invert pointers.
- Link infix headers in each block in an inverted list of inverted lists.
- Don't forget roots and weak pointers. */
+ Don't forget roots and weak pointers.
+ This is a mark-like pass. */
{
- /* Invert roots first because the threads library needs some heap
- data structures to find its roots. Fortunately, it doesn't need
- the headers (see above). */
caml_do_roots (caml_invert_root, 1);
/* The values to be finalised are not roots but should still be inverted */
caml_final_invert_finalisable_values ();
while ((char *) p < chend){
word q = *p;
- size_t sz, i;
+ mlsize_t wosz, i, first_field;
tag_t t;
- word *infixes;
-
- while (Ecolor (q) == 0) q = * (word *) q;
- sz = Whsize_ehd (q);
- t = Tag_ehd (q);
-
- if (t == Infix_tag){
- /* Get the original header of this block. */
- infixes = p + sz;
- q = *infixes;
- while (Ecolor (q) != 3) q = * (word *) (q & ~(uintnat)3);
- sz = Whsize_ehd (q);
- t = Tag_ehd (q);
- }
- if (t < No_scan_tag){
- for (i = 1; i < sz; i++) invert_pointer_at (&(p[i]));
+ while (Is_gray_hd (q)) q = * dptr (q);
+ wosz = Wosize_hd (q);
+ if (Is_white_hd (q)){
+ t = Tag_hd (q);
+ CAMLassert (t != Infix_tag);
+ if (t < No_scan_tag){
+ value v = Val_hp (p);
+ if (t == Closure_tag){
+ first_field = Start_env_closinfo (Closinfo_val (v));
+ }else{
+ first_field = 0;
+ }
+ for (i = first_field; i < wosz; i++){
+ invert_pointer_at ((word *) &Field (v,i));
+ }
+ }
}
- p += sz;
+ p += Whsize_wosize (wosz);
}
ch = Chunk_next (ch);
}
p = *pp;
if (p == (value) NULL) break;
q = Hd_val (p);
- while (Ecolor (q) == 0) q = * (word *) q;
- sz = Wosize_ehd (q);
+ while (Is_gray_hd (q)) q = * dptr (q);
+ CAMLassert (Is_white_hd (q));
+ sz = Wosize_hd (q);
for (i = 1; i < sz; i++){
if (Field (p,i) != caml_ephe_none){
invert_pointer_at ((word *) &(Field (p,i)));
}
- /* Third pass: reallocate virtually; revert pointers; decode headers.
- Rebuild infix headers. */
+ /* Third pass: reallocate virtually; revert pointers.
+ This is a sweep-like pass. */
{
init_compact_allocate ();
ch = caml_heap_start;
chend = ch + Chunk_size (ch);
while ((char *) p < chend){
- word q = *p;
+ header_t h = Hd_hp (p);
+ size_t sz;
+
+ while (Is_gray_hd (h)) h = * dptr (h);
+ sz = Whsize_hd (h);
- if (Ecolor (q) == 0 || Tag_ehd (q) == Infix_tag){
- /* There were (normal or infix) pointers to this block. */
- size_t sz;
+ CAMLassert (!Is_black_hd (h));
+ CAMLassert (!Is_gray_hd (h));
+ if (Is_white_hd (h)){
+ word q;
tag_t t;
char *newadr;
-#ifdef WITH_PROFINFO
- uintnat profinfo;
-#endif
- word *infixes = NULL;
- while (Ecolor (q) == 0) q = * (word *) q;
- sz = Whsize_ehd (q);
- t = Tag_ehd (q);
-#ifdef WITH_PROFINFO
- profinfo = Profinfo_ehd (q);
-#endif
- if (t == Infix_tag){
- /* Get the original header of this block. */
- infixes = p + sz;
- q = *infixes;
- CAMLassert (Ecolor (q) == 2);
- while (Ecolor (q) != 3) q = * (word *) (q & ~(uintnat)3);
- sz = Whsize_ehd (q);
- t = Tag_ehd (q);
- }
+ t = Tag_hd (h);
+ CAMLassert (t != Infix_tag);
newadr = compact_allocate (Bsize_wsize (sz));
q = *p;
- while (Ecolor (q) == 0){
- word next = * (word *) q;
- * (word *) q = (word) Val_hp (newadr);
- q = next;
+ while (Is_gray_hd (q)){
+ word *pp = dptr (q);
+ q = *pp;
+ *pp = (word) Val_hp (newadr);
}
- *p = Make_header_with_profinfo (Wosize_whsize (sz), t, Caml_white,
- profinfo);
-
- if (infixes != NULL){
- /* Rebuild the infix headers and revert the infix pointers. */
- while (Ecolor ((word) infixes) != 3){
- infixes = (word *) ((word) infixes & ~(uintnat) 3);
- q = *infixes;
- while (Ecolor (q) == 2){
- word next;
- q = (word) q & ~(uintnat) 3;
- next = * (word *) q;
- * (word *) q = (word) Val_hp ((word *) newadr + (infixes - p));
- q = next;
+ CAMLassert (q == h);
+ *p = q;
+
+ if (t == Closure_tag){
+ /* Revert the infix pointers to this block. */
+ mlsize_t i, startenv;
+ value v;
+
+ v = Val_hp (p);
+ startenv = Start_env_closinfo (Closinfo_val (v));
+ i = 0;
+ while (1){
+ int arity = Arity_closinfo (Field (v, i+1));
+ i += 2 + (arity != 0 && arity != 1);
+ if (i >= startenv) break;
+
+ /* Revert the inverted list for infix header at offset [i]. */
+ q = Field (v, i);
+ while (Is_gray_hd (q)){
+ word *pp = dptr (q);
+ q = *pp;
+ *pp = (word) Val_hp ((header_t *) &Field (Val_hp (newadr), i));
}
- CAMLassert (Ecolor (q) == 1 || Ecolor (q) == 3);
- /* No need to preserve any profinfo value on the [Infix_tag]
- headers; the Spacetime profiling heap snapshot code doesn't
- look at them. */
- *infixes = Make_header (infixes - p, Infix_tag, Caml_white);
- infixes = (word *) q;
+ CAMLassert (Tag_hd (q) == Infix_tag);
+ Field (v, i) = q;
+ ++i;
}
}
- p += sz;
- }else{
- CAMLassert (Ecolor (q) == 3);
- /* This is guaranteed only if caml_compact_heap was called after a
- nonincremental major GC: CAMLassert (Tag_ehd (q) == String_tag);
- */
- /* No pointers to the header and no infix header:
- the object was free. */
- *p = Make_header (Wosize_ehd (q), Tag_ehd (q), Caml_blue);
- p += Whsize_ehd (q);
}
+ p += sz;
}
ch = Chunk_next (ch);
}
}
}
++ Caml_state->stat_compactions;
+
+ caml_shrink_mark_stack();
+
caml_gc_message (0x10, "done.\n");
}
if (fp >= caml_percent_max){
caml_gc_message (0x200, "Automatic compaction triggered.\n");
caml_empty_minor_heap (); /* minor heap must be empty for compaction */
+ caml_gc_message
+ (0x1, "Finishing major GC cycle (triggered by compaction)\n");
caml_finish_major_cycle ();
+ ++ Caml_state->stat_forced_major_collections;
fw = caml_fl_cur_wsz;
fp = 100.0 * fw / (Caml_state->stat_heap_wsz - fw);
if (Is_long(v2))
return Long_val(v1) - Long_val(v2);
/* Subtraction above cannot overflow and cannot result in UNORDERED */
-#ifndef NO_NAKED_POINTERS
if (!Is_in_value_area(v2))
return LESS;
-#endif
- switch (Tag_val(v2)) {
+ switch (Tag_val(v2)) {
case Forward_tag:
v2 = Forward_val(v2);
continue;
return LESS; /* v1 long < v2 block */
}
if (Is_long(v2)) {
-#ifndef NO_NAKED_POINTERS
if (!Is_in_value_area(v1))
return GREATER;
-#endif
- switch (Tag_val(v1)) {
+ switch (Tag_val(v1)) {
case Forward_tag:
v1 = Forward_val(v1);
continue;
}
return GREATER; /* v1 block > v2 long */
}
-#ifndef NO_NAKED_POINTERS
/* If one of the objects is outside the heap (but is not an atom),
use address comparison. Since both addresses are 2-aligned,
shift lsb off to avoid overflow in subtraction. */
return (v1 >> 1) - (v2 >> 1);
/* Subtraction above cannot result in UNORDERED */
}
-#endif
t1 = Tag_val(v1);
t2 = Tag_val(v2);
- if (t1 == Forward_tag) { v1 = Forward_val (v1); continue; }
- if (t2 == Forward_tag) { v2 = Forward_val (v2); continue; }
- if (t1 != t2) return (intnat)t1 - (intnat)t2;
+ if (t1 != t2) {
+ /* Besides long/block comparisons, the only forms of
+ heterogeneous comparisons we support are:
+ - Forward_tag pointers, which may point to values of any type, and
+ - comparing Infix_tag and Closure_tag functions (#9521).
+
+ Other heterogeneous cases may still happen due to
+ existential types, and we just compare the tags.
+ */
+ if (t1 == Forward_tag) { v1 = Forward_val (v1); continue; }
+ if (t2 == Forward_tag) { v2 = Forward_val (v2); continue; }
+ if (t1 == Infix_tag) t1 = Closure_tag;
+ if (t2 == Infix_tag) t2 = Closure_tag;
+ if (t1 != t2)
+ return (intnat)t1 - (intnat)t2;
+ }
switch(t1) {
+ case Forward_tag: {
+ v1 = Forward_val (v1);
+ v2 = Forward_val (v2);
+ continue;
+ }
case String_tag: {
mlsize_t len1, len2;
int res;
#include "caml/memory.h"
#include "caml/mlvalues.h"
#include "caml/signals.h"
+#include "caml/memprof.h"
uintnat caml_custom_major_ratio = Custom_major_ratio_def;
uintnat caml_custom_minor_ratio = Custom_minor_ratio_def;
Bsize_wsize (Caml_state->stat_heap_wsz) / 150 * caml_custom_major_ratio;
mlsize_t max_minor =
Bsize_wsize (Caml_state->minor_heap_wsz) / 100 * caml_custom_minor_ratio;
- return alloc_custom_gen (ops, bsz, mem, max_major, mem_minor, max_minor);
+ value v = alloc_custom_gen (ops, bsz, mem, max_major, mem_minor, max_minor);
+ caml_memprof_track_custom(v, mem);
+ return v;
}
struct custom_operations_list {
return ops;
}
-extern struct custom_operations caml_int32_ops,
- caml_nativeint_ops,
- caml_int64_ops,
- caml_ba_ops;
-
void caml_init_custom_operations(void)
{
caml_register_custom_operations(&caml_int32_ops);
{
}
-void caml_debugger_cleanup_fork(void)
+CAMLexport void caml_debugger_cleanup_fork(void)
{
}
#endif
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");
if (!caml_debugger_in_use) caml_putword(dbg_out, -1); /* first connection */
#ifdef _WIN32
caml_putword(dbg_out, _getpid());
}
}
-void caml_debugger_cleanup_fork(void)
+CAMLexport void caml_debugger_cleanup_fork(void)
{
/* We could remove all of the event points, but closing the connection
* means that they'll just be skipped anyway. */
Caml_state->stat_heap_wsz = 0;
Caml_state->stat_top_heap_wsz = 0;
Caml_state->stat_compactions = 0;
+ Caml_state->stat_forced_major_collections = 0;
Caml_state->stat_heap_chunks = 0;
Caml_state->backtrace_active = 0;
Caml_state->eventlog_startup_pid = 0;
Caml_state->eventlog_startup_timestamp = 0;
Caml_state->eventlog_out = NULL;
+
+#if defined(NAKED_POINTERS_CHECKER) && !defined(_WIN32)
+ Caml_state->checking_pointer_pc = NULL;
+ #endif
}
(rule
(targets primitives)
(mode fallback)
- (deps alloc.c array.c compare.c extern.c floats.c gc_ctrl.c hash.c intern.c
- interp.c ints.c io.c lexing.c md5.c meta.c obj.c parsing.c signals.c
- str.c sys.c callback.c weak.c finalise.c stacks.c dynlink.c
- backtrace_byt.c backtrace.c spacetime_byt.c afl.c bigarray.c)
+ (deps
+ ; matches the line structure of files in gen_primitives.sh
+ alloc.c array.c compare.c extern.c floats.c gc_ctrl.c hash.c intern.c
+ interp.c ints.c io.c
+ lexing.c md5.c meta.c memprof.c obj.c parsing.c signals.c str.c sys.c
+ callback.c weak.c
+ finalise.c stacks.c dynlink.c backtrace_byt.c backtrace.c
+ afl.c
+ bigarray.c eventlog.c)
(action (with-stdout-to %{targets} (run %{dep:gen_primitives.sh}))))
(rule
(targets libcamlrun.a)
(mode fallback)
- (deps ../Makefile.config ../Makefile.common Makefile
- (glob_files caml/*.h)
- interp.c misc.c stacks.c fix_code.c startup_aux.c startup_byt.c
- freelist.c major_gc.c minor_gc.c memory.c alloc.c roots_byt.c
- globroots.c fail_byt.c signals.c signals_byt.c printexc.c
- backtrace_byt.c backtrace.c compare.c ints.c floats.c str.c array.c
- io.c extern.c intern.c hash.c sys.c meta.c parsing.c gc_ctrl.c md5.c
- obj.c lexing.c callback.c debugger.c weak.c compact.c finalise.c
- custom.c dynlink.c spacetime_byt.c afl.c unix.c win32.c bigarray.c
- main.c memprof.c domain.c)
+ (deps
+ ../Makefile.config
+ ../Makefile.build_config
+ ../Makefile.config_if_required
+ ../Makefile.common Makefile
+ (glob_files caml/*.h)
+ ; matches the line structure of files in Makefile/BYTECODE_C_SOURCES
+ interp.c misc.c stacks.c fix_code.c startup_aux.c startup_byt.c freelist.c
+ major_gc.c
+ minor_gc.c memory.c alloc.c roots_byt.c globroots.c fail_byt.c signals.c
+ signals_byt.c printexc.c backtrace_byt.c backtrace.c compare.c ints.c
+ eventlog.c
+ floats.c str.c array.c io.c extern.c intern.c hash.c sys.c meta.c parsing.c
+ gc_ctrl.c md5.c obj.c
+ lexing.c callback.c debugger.c weak.c compact.c finalise.c custom.c dynlink.c
+ afl.c unix.c win32.c bigarray.c main.c memprof.c domain.c
+ skiplist.c codefrag.c
+ )
(action
(progn
(bash "touch .depend") ; hack.
- (run make %{targets})
+ (run make %{targets} COMPUTE_DEPS=false)
(bash "rm .depend"))))
;; HACK
#include "caml/osdeps.h"
#include "caml/fail.h"
#include "caml/signals.h"
-#ifdef WITH_SPACETIME
-#include "caml/spacetime.h"
-#endif
#include "caml/hooks.h"
sym = optsym("__frametable");
if (NULL != sym) caml_register_frametable(sym);
-#ifdef WITH_SPACETIME
- sym = optsym("__spacetime_shapes");
- if (NULL != sym) caml_spacetime_register_shapes(sym);
-#endif
-
sym = optsym("__gc_roots");
if (NULL != sym) caml_register_dyn_global(sym);
sym = optsym("__code_begin");
sym2 = optsym("__code_end");
- if (NULL != sym && NULL != sym2) {
- caml_page_table_add(In_code_area, sym, sym2);
+ if (NULL != sym && NULL != sym2)
caml_register_code_fragment((char *) sym, (char *) sym2,
DIGEST_LATER, NULL);
- }
if( caml_natdynlink_hook != NULL ) caml_natdynlink_hook(handle,unit);
eventlog_filename = caml_secure_getenv(T("OCAML_EVENTLOG_PREFIX"));
if (eventlog_filename) {
- int ret = snprintf_os(output_file, OUTPUT_FILE_LEN, T("%s.%d.eventlog"),
+ int ret = snprintf_os(output_file, OUTPUT_FILE_LEN, T("%s.%ld.eventlog"),
eventlog_filename, Caml_state->eventlog_startup_pid);
if (ret > OUTPUT_FILE_LEN)
caml_fatal_error("eventlog: specified OCAML_EVENTLOG_PREFIX is too long");
} else {
- snprintf_os(output_file, OUTPUT_FILE_LEN, T("caml-%d.eventlog"),
+ snprintf_os(output_file, OUTPUT_FILE_LEN, T("caml-%ld.eventlog"),
Caml_state->eventlog_startup_pid);
}
}
#endif
-/* Marshal the given value in the output buffer */
+/* Marshaling integers */
+
+Caml_inline void extern_int(intnat n)
+{
+ if (n >= 0 && n < 0x40) {
+ write(PREFIX_SMALL_INT + n);
+ } else if (n >= -(1 << 7) && n < (1 << 7)) {
+ writecode8(CODE_INT8, n);
+ } else if (n >= -(1 << 15) && n < (1 << 15)) {
+ writecode16(CODE_INT16, n);
+#ifdef ARCH_SIXTYFOUR
+ } else if (n < -((intnat)1 << 30) || n >= ((intnat)1 << 30)) {
+ if (extern_flags & COMPAT_32)
+ extern_failwith("output_value: integer cannot be read back on "
+ "32-bit platform");
+ writecode64(CODE_INT64, n);
+#endif
+ } else {
+ writecode32(CODE_INT32, n);
+ }
+}
-int caml_extern_allow_out_of_heap = 0;
+/* Marshaling references to previously-marshaled blocks */
-static void extern_rec(value v)
+Caml_inline void extern_shared_reference(uintnat d)
+{
+ if (d < 0x100) {
+ writecode8(CODE_SHARED8, d);
+ } else if (d < 0x10000) {
+ writecode16(CODE_SHARED16, d);
+#ifdef ARCH_SIXTYFOUR
+ } else if (d >= (uintnat)1 << 32) {
+ writecode64(CODE_SHARED64, d);
+#endif
+ } else {
+ writecode32(CODE_SHARED32, d);
+ }
+}
+
+/* Marshaling block headers */
+
+Caml_inline void extern_header(mlsize_t sz, tag_t tag)
+{
+ if (tag < 16 && sz < 8) {
+ write(PREFIX_SMALL_BLOCK + tag + (sz << 4));
+ } else {
+ header_t hd = Make_header(sz, tag, Caml_white);
+#ifdef ARCH_SIXTYFOUR
+ if (sz > 0x3FFFFF && (extern_flags & COMPAT_32))
+ extern_failwith("output_value: array cannot be read back on "
+ "32-bit platform");
+ if (hd < (uintnat)1 << 32)
+ writecode32(CODE_BLOCK32, hd);
+ else
+ writecode64(CODE_BLOCK64, hd);
+#else
+ writecode32(CODE_BLOCK32, hd);
+#endif
+ }
+}
+
+/* Marshaling strings */
+
+Caml_inline void extern_string(value v, mlsize_t len)
+{
+ if (len < 0x20) {
+ write(PREFIX_SMALL_STRING + len);
+ } else if (len < 0x100) {
+ writecode8(CODE_STRING8, len);
+ } else {
+#ifdef ARCH_SIXTYFOUR
+ if (len > 0xFFFFFB && (extern_flags & COMPAT_32))
+ extern_failwith("output_value: string cannot be read back on "
+ "32-bit platform");
+ if (len < (uintnat)1 << 32)
+ writecode32(CODE_STRING32, len);
+ else
+ writecode64(CODE_STRING64, len);
+#else
+ writecode32(CODE_STRING32, len);
+#endif
+ }
+ writeblock(String_val(v), len);
+}
+
+/* Marshaling FP numbers */
+
+Caml_inline void extern_double(value v)
+{
+ write(CODE_DOUBLE_NATIVE);
+ writeblock_float8((double *) v, 1);
+}
+
+/* Marshaling FP arrays */
+
+Caml_inline void extern_double_array(value v, mlsize_t nfloats)
+{
+ if (nfloats < 0x100) {
+ writecode8(CODE_DOUBLE_ARRAY8_NATIVE, nfloats);
+ } else {
+#ifdef ARCH_SIXTYFOUR
+ if (nfloats > 0x1FFFFF && (extern_flags & COMPAT_32))
+ extern_failwith("output_value: float array cannot be read back on "
+ "32-bit platform");
+ if (nfloats < (uintnat) 1 << 32)
+ writecode32(CODE_DOUBLE_ARRAY32_NATIVE, nfloats);
+ else
+ writecode64(CODE_DOUBLE_ARRAY64_NATIVE, nfloats);
+#else
+ writecode32(CODE_DOUBLE_ARRAY32_NATIVE, nfloats);
+#endif
+ }
+ writeblock_float8((double *) v, nfloats);
+}
+
+/* Marshaling custom blocks */
+
+Caml_inline void extern_custom(value v,
+ /*out*/ uintnat * sz_32,
+ /*out*/ uintnat * sz_64)
+{
+ char * size_header;
+ char const * ident = Custom_ops_val(v)->identifier;
+ void (*serialize)(value v, uintnat * bsize_32, uintnat * bsize_64)
+ = Custom_ops_val(v)->serialize;
+ const struct custom_fixed_length* fixed_length
+ = Custom_ops_val(v)->fixed_length;
+ if (serialize == NULL)
+ extern_invalid_argument("output_value: abstract value (Custom)");
+ if (fixed_length == NULL) {
+ write(CODE_CUSTOM_LEN);
+ writeblock(ident, strlen(ident) + 1);
+ /* Reserve 12 bytes for the lengths (sz_32 and sz_64). */
+ if (extern_ptr + 12 >= extern_limit) grow_extern_output(12);
+ size_header = extern_ptr;
+ extern_ptr += 12;
+ serialize(v, sz_32, sz_64);
+ /* Store length before serialized block */
+ store32(size_header, *sz_32);
+ store64(size_header + 4, *sz_64);
+ } else {
+ write(CODE_CUSTOM_FIXED);
+ writeblock(ident, strlen(ident) + 1);
+ serialize(v, sz_32, sz_64);
+ if (*sz_32 != fixed_length->bsize_32 ||
+ *sz_64 != fixed_length->bsize_64)
+ caml_fatal_error(
+ "output_value: incorrect fixed sizes specified by %s",
+ ident);
+ }
+}
+
+/* Marshaling code pointers */
+
+static void extern_code_pointer(char * codeptr)
{
struct code_fragment * cf;
+ const char * digest;
+
+ cf = caml_find_code_fragment_by_pc(codeptr);
+ if (cf != NULL) {
+ if ((extern_flags & CLOSURES) == 0)
+ extern_invalid_argument("output_value: functional value");
+ digest = (const char *) caml_digest_of_code_fragment(cf);
+ if (digest == NULL)
+ extern_invalid_argument("output_value: private function");
+ writecode32(CODE_CODEPOINTER, codeptr - cf->code_start);
+ writeblock(digest, 16);
+ } else {
+ extern_invalid_argument("output_value: abstract value (outside heap)");
+ }
+}
+
+/* Marshaling the non-environment part of closures */
+
+#ifdef NO_NAKED_POINTERS
+Caml_inline mlsize_t extern_closure_up_to_env(value v)
+{
+ mlsize_t startenv, i;
+ value info;
+
+ startenv = Start_env_closinfo(Closinfo_val(v));
+ i = 0;
+ do {
+ /* The infix header */
+ if (i > 0) extern_int(Long_val(Field(v, i++)));
+ /* The default entry point */
+ extern_code_pointer((char *) Field(v, i++));
+ /* The closure info. */
+ info = Field(v, i++);
+ extern_int(Long_val(info));
+ /* The direct entry point if arity is neither 0 nor 1 */
+ if (Arity_closinfo(info) != 0 && Arity_closinfo(info) != 1) {
+ extern_code_pointer((char *) Field(v, i++));
+ }
+ } while (i < startenv);
+ CAMLassert(i == startenv);
+ return startenv;
+}
+#endif
+
+/* Marshal the given value in the output buffer */
+
+static void extern_rec(value v)
+{
struct extern_item * sp;
uintnat h = 0;
uintnat pos = 0;
while(1) {
if (Is_long(v)) {
- intnat n = Long_val(v);
- if (n >= 0 && n < 0x40) {
- write(PREFIX_SMALL_INT + n);
- } else if (n >= -(1 << 7) && n < (1 << 7)) {
- writecode8(CODE_INT8, n);
- } else if (n >= -(1 << 15) && n < (1 << 15)) {
- writecode16(CODE_INT16, n);
-#ifdef ARCH_SIXTYFOUR
- } else if (n < -((intnat)1 << 30) || n >= ((intnat)1 << 30)) {
- if (extern_flags & COMPAT_32)
- extern_failwith("output_value: integer cannot be read back on "
- "32-bit platform");
- writecode64(CODE_INT64, n);
-#endif
- } else
- writecode32(CODE_INT32, n);
- goto next_item;
+ extern_int(Long_val(v));
+ }
+ else if (! (Is_in_value_area(v))) {
+ /* Naked pointer outside the heap: try to marshal it as a code pointer,
+ otherwise fail. */
+ extern_code_pointer((char *) v);
}
- if (Is_in_value_area(v) || caml_extern_allow_out_of_heap) {
+ else {
header_t hd = Hd_val(v);
tag_t tag = Tag_hd(hd);
mlsize_t sz = Wosize_hd(hd);
/* Atoms are treated specially for two reasons: they are not allocated
in the externed block, and they are automatically shared. */
if (sz == 0) {
- if (tag < 16) {
- write(PREFIX_SMALL_BLOCK + tag);
- } else {
-#ifdef WITH_PROFINFO
- writecode32(CODE_BLOCK32, Hd_no_profinfo(hd));
-#else
- writecode32(CODE_BLOCK32, hd);
-#endif
- }
+ extern_header(0, tag);
goto next_item;
}
/* Check if object already seen */
if (! (extern_flags & NO_SHARING)) {
if (extern_lookup_position(v, &pos, &h)) {
- uintnat d = obj_counter - pos;
- if (d < 0x100) {
- writecode8(CODE_SHARED8, d);
- } else if (d < 0x10000) {
- writecode16(CODE_SHARED16, d);
-#ifdef ARCH_SIXTYFOUR
- } else if (d >= (uintnat)1 << 32) {
- writecode64(CODE_SHARED64, d);
-#endif
- } else {
- writecode32(CODE_SHARED32, d);
- }
+ extern_shared_reference(obj_counter - pos);
goto next_item;
}
}
-
/* Output the contents of the object */
switch(tag) {
case String_tag: {
mlsize_t len = caml_string_length(v);
- if (len < 0x20) {
- write(PREFIX_SMALL_STRING + len);
- } else if (len < 0x100) {
- writecode8(CODE_STRING8, len);
- } else {
-#ifdef ARCH_SIXTYFOUR
- if (len > 0xFFFFFB && (extern_flags & COMPAT_32))
- extern_failwith("output_value: string cannot be read back on "
- "32-bit platform");
- if (len < (uintnat)1 << 32)
- writecode32(CODE_STRING32, len);
- else
- writecode64(CODE_STRING64, len);
-#else
- writecode32(CODE_STRING32, len);
-#endif
- }
- writeblock(String_val(v), len);
+ extern_string(v, len);
size_32 += 1 + (len + 4) / 4;
size_64 += 1 + (len + 8) / 8;
extern_record_location(v, h);
break;
}
case Double_tag: {
- if (sizeof(double) != 8)
- extern_invalid_argument("output_value: non-standard floats");
- write(CODE_DOUBLE_NATIVE);
- writeblock_float8((double *) v, 1);
+ CAMLassert(sizeof(double) == 8);
+ extern_double(v);
size_32 += 1 + 2;
size_64 += 1 + 1;
extern_record_location(v, h);
}
case Double_array_tag: {
mlsize_t nfloats;
- if (sizeof(double) != 8)
- extern_invalid_argument("output_value: non-standard floats");
+ CAMLassert(sizeof(double) == 8);
nfloats = Wosize_val(v) / Double_wosize;
- if (nfloats < 0x100) {
- writecode8(CODE_DOUBLE_ARRAY8_NATIVE, nfloats);
- } else {
-#ifdef ARCH_SIXTYFOUR
- if (nfloats > 0x1FFFFF && (extern_flags & COMPAT_32))
- extern_failwith("output_value: float array cannot be read back on "
- "32-bit platform");
- if (nfloats < (uintnat) 1 << 32)
- writecode32(CODE_DOUBLE_ARRAY32_NATIVE, nfloats);
- else
- writecode64(CODE_DOUBLE_ARRAY64_NATIVE, nfloats);
-#else
- writecode32(CODE_DOUBLE_ARRAY32_NATIVE, nfloats);
-#endif
- }
- writeblock_float8((double *) v, nfloats);
+ extern_double_array(v, nfloats);
size_32 += 1 + nfloats * 2;
size_64 += 1 + nfloats;
extern_record_location(v, h);
continue;
case Custom_tag: {
uintnat sz_32, sz_64;
- char * size_header;
- char const * ident = Custom_ops_val(v)->identifier;
- void (*serialize)(value v, uintnat * bsize_32,
- uintnat * bsize_64)
- = Custom_ops_val(v)->serialize;
- const struct custom_fixed_length* fixed_length
- = Custom_ops_val(v)->fixed_length;
- if (serialize == NULL)
- extern_invalid_argument("output_value: abstract value (Custom)");
- if (fixed_length == NULL) {
- write(CODE_CUSTOM_LEN);
- writeblock(ident, strlen(ident) + 1);
- /* Reserve 12 bytes for the lengths (sz_32 and sz_64). */
- if (extern_ptr + 12 >= extern_limit) grow_extern_output(12);
- size_header = extern_ptr;
- extern_ptr += 12;
- serialize(v, &sz_32, &sz_64);
- /* Store length before serialized block */
- store32(size_header, sz_32);
- store64(size_header + 4, sz_64);
- } else {
- write(CODE_CUSTOM_FIXED);
- writeblock(ident, strlen(ident) + 1);
- serialize(v, &sz_32, &sz_64);
- if (sz_32 != fixed_length->bsize_32 ||
- sz_64 != fixed_length->bsize_64)
- caml_fatal_error(
- "output_value: incorrect fixed sizes specified by %s",
- ident);
- }
+ extern_custom(v, &sz_32, &sz_64);
size_32 += 2 + ((sz_32 + 3) >> 2); /* header + ops + data */
size_64 += 2 + ((sz_64 + 7) >> 3);
extern_record_location(v, h);
break;
}
- default: {
- value field0;
- if (tag < 16 && sz < 8) {
- write(PREFIX_SMALL_BLOCK + tag + (sz << 4));
- } else {
-#ifdef ARCH_SIXTYFOUR
-#ifdef WITH_PROFINFO
- header_t hd_erased = Hd_no_profinfo(hd);
-#else
- header_t hd_erased = hd;
-#endif
- if (sz > 0x3FFFFF && (extern_flags & COMPAT_32))
- extern_failwith("output_value: array cannot be read back on "
- "32-bit platform");
- if (hd_erased < (uintnat)1 << 32)
- writecode32(CODE_BLOCK32, Whitehd_hd (hd_erased));
- else
- writecode64(CODE_BLOCK64, Whitehd_hd (hd_erased));
-#else
- writecode32(CODE_BLOCK32, Whitehd_hd (hd));
-#endif
+#ifdef NO_NAKED_POINTERS
+ case Closure_tag: {
+ mlsize_t i;
+ extern_header(sz, tag);
+ size_32 += 1 + sz;
+ size_64 += 1 + sz;
+ extern_record_location(v, h);
+ i = extern_closure_up_to_env(v);
+ if (i >= sz) goto next_item;
+ /* Remember that we still have to serialize fields i + 1 ... sz - 1 */
+ if (i < sz - 1) {
+ sp++;
+ if (sp >= extern_stack_limit) sp = extern_resize_stack(sp);
+ sp->v = &Field(v, i + 1);
+ sp->count = sz - i - 1;
}
+ /* Continue serialization with the first environment field */
+ v = Field(v, i);
+ continue;
+ }
+#endif
+ default: {
+ extern_header(sz, tag);
size_32 += 1 + sz;
size_64 += 1 + sz;
- field0 = Field(v, 0);
extern_record_location(v, h);
/* Remember that we still have to serialize fields 1 ... sz - 1 */
if (sz > 1) {
sp++;
if (sp >= extern_stack_limit) sp = extern_resize_stack(sp);
- sp->v = &Field(v,1);
- sp->count = sz-1;
+ sp->v = &Field(v, 1);
+ sp->count = sz - 1;
}
/* Continue serialization with the first field */
- v = field0;
+ v = Field(v, 0);
continue;
}
}
}
- else if ((cf = caml_find_code_fragment_by_pc((char*) v)) != NULL) {
- const char * digest;
- if ((extern_flags & CLOSURES) == 0)
- extern_invalid_argument("output_value: functional value");
- digest = (const char *) caml_digest_of_code_fragment(cf);
- if (digest == NULL)
- extern_invalid_argument("output_value: private function");
- writecode32(CODE_CODEPOINTER, (char *) v - cf->code_start);
- writeblock(digest, 16);
- } else {
- extern_invalid_argument("output_value: abstract value (outside heap)");
- }
next_item:
/* Pop one more item to marshal, if any */
if (sp == extern_stack) {
}
#endif
}
+
+CAMLprim value caml_obj_reachable_words(value v)
+{
+ intnat size;
+ struct extern_item * sp;
+ uintnat h = 0;
+ uintnat pos;
+
+ extern_init_position_table();
+ sp = extern_stack;
+ size = 0;
+ while (1) {
+ if (Is_long(v)) {
+ /* Tagged integers contribute 0 to the size, nothing to do */
+ } else if (! Is_in_heap_or_young(v)) {
+ /* Out-of-heap blocks contribute 0 to the size, nothing to do */
+ /* However, in no-naked-pointers mode, we don't distinguish
+ between major heap blocks and out-of-heap blocks,
+ and the test above is always false,
+ so we end up counting out-of-heap blocks too. */
+ } else if (extern_lookup_position(v, &pos, &h)) {
+ /* Already seen and counted, nothing to do */
+ } else {
+ header_t hd = Hd_val(v);
+ tag_t tag = Tag_hd(hd);
+ mlsize_t sz = Wosize_hd(hd);
+ /* Infix pointer: go back to containing closure */
+ if (tag == Infix_tag) {
+ v = v - Infix_offset_hd(hd);
+ continue;
+ }
+ /* Remember that we've visited this block */
+ extern_record_location(v, h);
+ /* The block contributes to the total size */
+ size += 1 + sz; /* header word included */
+ if (tag < No_scan_tag) {
+ /* i is the position of the first field to traverse recursively */
+ uintnat i =
+ tag == Closure_tag ? Start_env_closinfo(Closinfo_val(v)) : 0;
+ if (i < sz) {
+ if (i < sz - 1) {
+ /* Remember that we need to count fields i + 1 ... sz - 1 */
+ sp++;
+ if (sp >= extern_stack_limit) sp = extern_resize_stack(sp);
+ sp->v = &Field(v, i + 1);
+ sp->count = sz - i - 1;
+ }
+ /* Continue with field i */
+ v = Field(v, i);
+ continue;
+ }
+ }
+ }
+ /* Pop one more item to traverse, if any */
+ if (sp == extern_stack) break;
+ v = *((sp->v)++);
+ if (--(sp->count) == 0) sp--;
+ }
+ extern_free_stack();
+ extern_free_position_table();
+ return Val_long(size);
+}
CAMLexport void caml_raise(value v)
{
Unlock_exn();
+ CAMLassert(!Is_exception_result(v));
+
+ // avoid calling caml_raise recursively
+ v = caml_process_pending_actions_with_root_exn(v);
+ if (Is_exception_result(v))
+ v = Extract_exception(v);
+
Caml_state->exn_bucket = v;
if (Caml_state->external_raise == NULL) caml_fatal_uncaught_exception(v);
siglongjmp(Caml_state->external_raise->buf, 1);
caml_raise_constant(Field(caml_global_data, SYS_BLOCKED_IO));
}
-value caml_raise_if_exception(value res)
+CAMLexport value caml_raise_if_exception(value res)
{
if (Is_exception_result(res)) caml_raise(Extract_exception(res));
return res;
void caml_raise(value v)
{
Unlock_exn();
+
+ CAMLassert(!Is_exception_result(v));
+
+ // avoid calling caml_raise recursively
+ v = caml_process_pending_actions_with_root_exn(v);
+ if (Is_exception_result(v))
+ v = Extract_exception(v);
+
if (Caml_state->exception_pointer == NULL) caml_fatal_uncaught_exception(v);
while (Caml_state->local_roots != NULL &&
caml_raise_constant((value) caml_exn_Sys_blocked_io);
}
-value caml_raise_if_exception(value res)
+CAMLexport value caml_raise_if_exception(value res)
{
if (Is_exception_result(res)) caml_raise(Extract_exception(res));
return res;
#include "caml/mlvalues.h"
#include "caml/roots.h"
#include "caml/signals.h"
-#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
-#include "caml/spacetime.h"
-#endif
struct final {
value fun;
{
struct final f;
value res;
-#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
- void* saved_spacetime_trie_node_ptr;
-#endif
if (!running_finalisation_function && to_do_hd != NULL){
if (caml_finalise_begin_hook != NULL) (*caml_finalise_begin_hook) ();
-- to_do_hd->size;
f = to_do_hd->item[to_do_hd->size];
running_finalisation_function = 1;
-#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
- /* We record the finaliser's execution separately.
- (The code of [caml_callback_exn] will do the hard work of finding
- the correct place in the trie.) */
- saved_spacetime_trie_node_ptr = caml_spacetime_trie_node_ptr;
- caml_spacetime_trie_node_ptr = caml_spacetime_finaliser_trie_root;
-#endif
res = caml_callback_exn (f.fun, f.val + f.offset);
-#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
- caml_spacetime_trie_node_ptr = saved_spacetime_trie_node_ptr;
-#endif
running_finalisation_function = 0;
if (Is_exception_result (res)) return res;
}
{
return caml_classify_float_unboxed(Double_val(vd));
}
-
-/* The [caml_init_ieee_float] function should initialize floating-point hardware
- so that it behaves as much as possible like the IEEE standard.
- In particular, return special numbers like Infinity and NaN instead
- of signalling exceptions. Currently, everyone is in IEEE mode
- at program startup, except FreeBSD prior to 4.0R. */
-
-#ifdef __FreeBSD__
-#include <osreldate.h>
-#if (__FreeBSD_version < 400017)
-#include <floatingpoint.h>
-#endif
-#endif
-
-void caml_init_ieee_floats(void)
-{
-#if defined(__FreeBSD__) && (__FreeBSD_version < 400017)
- fpsetmask(0);
-#endif
-}
return Hp_val (block);
}else{
/* allocate from the next available size */
- mlsize_t s = ffs (bf_small_map & ((-1) << wosz));
+ mlsize_t s = ffs (bf_small_map & ((~0U) << wosz));
FREELIST_DEBUG_bf_check ();
if (s != 0){
block = bf_small_fl[s].free;
switch (Color_val (cur)){
case Caml_white: goto white;
case Caml_blue: bf_remove (cur); goto next;
- case Caml_gray:
case Caml_black:
goto end_of_run;
}
}
}
break;
- case Caml_gray: case Caml_black:
+ case Caml_black:
CAMLassert (Wosize_hd (cur_hd) > 0);
++ live_blocks;
live_words += Whsize_hd (cur_hd);
intnat majcoll = Caml_state->stat_major_collections;
intnat heap_words = Caml_state->stat_heap_wsz;
intnat cpct = Caml_state->stat_compactions;
+ intnat forcmajcoll = Caml_state->stat_forced_major_collections;
intnat top_heap_words = Caml_state->stat_top_heap_wsz;
- res = caml_alloc_tuple (16);
+ res = caml_alloc_tuple (17);
Store_field (res, 0, caml_copy_double (minwords));
Store_field (res, 1, caml_copy_double (prowords));
Store_field (res, 2, caml_copy_double (majwords));
Store_field (res, 13, Val_long (cpct));
Store_field (res, 14, Val_long (top_heap_words));
Store_field (res, 15, Val_long (caml_stack_usage()));
+ Store_field (res, 16, Val_long (forcmajcoll));
CAMLreturn (res);
}else{
CAMLreturn (Val_unit);
intnat heap_words = Caml_state->stat_heap_wsz;
intnat top_heap_words = Caml_state->stat_top_heap_wsz;
intnat cpct = Caml_state->stat_compactions;
+ intnat forcmajcoll = Caml_state->stat_forced_major_collections;
intnat heap_chunks = Caml_state->stat_heap_chunks;
- res = caml_alloc_tuple (16);
+ res = caml_alloc_tuple (17);
Store_field (res, 0, caml_copy_double (minwords));
Store_field (res, 1, caml_copy_double (prowords));
Store_field (res, 2, caml_copy_double (majwords));
Store_field (res, 13, Val_long (cpct));
Store_field (res, 14, Val_long (top_heap_words));
Store_field (res, 15, Val_long (caml_stack_usage()));
+ Store_field (res, 16, Val_long (forcmajcoll));
CAMLreturn (res);
}
newpolicy = Long_val (Field (v, 6));
if (newpolicy != caml_allocation_policy){
caml_empty_minor_heap ();
+ caml_gc_message (0x1, "Full major GC cycle (changing allocation policy)\n");
caml_finish_major_cycle ();
caml_finish_major_cycle ();
+ ++ Caml_state->stat_forced_major_collections;
caml_compact_heap (newpolicy);
caml_gc_message (0x20, "New allocation policy: %"
ARCH_INTNAT_PRINTF_FORMAT "u\n", newpolicy);
CAML_EV_BEGIN(EV_EXPLICIT_GC_MAJOR);
CAMLassert (v == Val_unit);
- caml_gc_message (0x1, "Major GC cycle requested\n");
+ caml_gc_message (0x1, "Finishing major GC cycle (requested by user)\n");
caml_empty_minor_heap ();
caml_finish_major_cycle ();
test_and_compact ();
CAML_EV_BEGIN(EV_EXPLICIT_GC_FULL_MAJOR);
CAMLassert (v == Val_unit);
- caml_gc_message (0x1, "Full major GC cycle requested\n");
+ caml_gc_message (0x1, "Full major GC cycle (requested by user)\n");
caml_empty_minor_heap ();
caml_finish_major_cycle ();
// call finalisers
if (Is_exception_result(exn)) goto cleanup;
caml_empty_minor_heap ();
caml_finish_major_cycle ();
+ ++ Caml_state->stat_forced_major_collections;
test_and_compact ();
// call finalisers
exn = caml_process_pending_actions_exn();
CAMLprim value caml_gc_major_slice (value v)
{
+ value exn = Val_unit;
CAML_EV_BEGIN(EV_EXPLICIT_GC_MAJOR_SLICE);
CAMLassert (Is_long (v));
- caml_major_collection_slice (Long_val (v));
+ if (caml_gc_phase == Phase_idle){
+ /* We need to start a new major GC cycle. Go through the pending_action
+ machinery. */
+ caml_request_major_slice ();
+ exn = caml_process_pending_actions_exn ();
+ /* Calls the major GC without passing [v] but the initial slice
+ ignores this parameter anyway. */
+ }else{
+ caml_major_collection_slice (Long_val (v));
+ }
CAML_EV_END(EV_EXPLICIT_GC_MAJOR_SLICE);
+ caml_raise_if_exception (exn);
return Val_long (0);
}
CAMLassert (v == Val_unit);
caml_gc_message (0x10, "Heap compaction requested\n");
caml_empty_minor_heap ();
+ caml_gc_message (0x1, "Full major GC cycle (compaction)\n");
caml_finish_major_cycle ();
// call finalisers
exn = caml_process_pending_actions_exn();
if (Is_exception_result(exn)) goto cleanup;
caml_empty_minor_heap ();
caml_finish_major_cycle ();
+ ++ Caml_state->stat_forced_major_collections;
caml_compact_heap (-1);
// call finalisers
exn = caml_process_pending_actions_exn();
for prim in \
alloc array compare extern floats gc_ctrl hash intern interp ints io \
lexing md5 meta memprof obj parsing signals str sys callback weak \
- finalise stacks dynlink backtrace_byt backtrace spacetime_byt afl \
+ finalise stacks dynlink backtrace_byt backtrace afl \
bigarray eventlog
do
sed -n -e 's/^CAMLprim value \([a-z0-9_][a-z0-9_]*\).*/\1/p' "$prim.c"
{
if(!Is_block(v)) return UNTRACKED;
if(Is_young(v)) return YOUNG;
- if(Is_in_heap(v)) return OLD;
- return UNTRACKED;
+#ifndef NO_NAKED_POINTERS
+ if(!Is_in_heap(v)) return UNTRACKED;
+#endif
+ return OLD;
}
/* Register a global C root of the generational kind */
#include "caml/memory.h"
#include "caml/hash.h"
-/* The new implementation, based on MurmurHash 3,
- http://code.google.com/p/smhasher/ */
+/* The implementation based on MurmurHash 3,
+ https://github.com/aappleby/smhasher/ */
#define ROTL32(x,n) ((x) << n | (x) >> (32-n))
h = caml_hash_mix_intnat(h, v);
num--;
}
- else if (Is_in_value_area(v)) {
+ else if (!Is_in_value_area(v)) {
+ /* v is a pointer outside the heap, probably a code pointer.
+ Shall we count it? Let's say yes by compatibility with old code. */
+ h = caml_hash_mix_intnat(h, v);
+ num--;
+ }
+ else {
switch (Tag_val(v)) {
case String_tag:
h = caml_hash_mix_string(h, v);
num--;
}
break;
+#ifdef NO_NAKED_POINTERS
+ case Closure_tag: {
+ mlsize_t startenv;
+ len = Wosize_val(v);
+ startenv = Start_env_closinfo(Closinfo_val(v));
+ CAMLassert (startenv <= len);
+ /* Mix in the tag and size, but do not count this towards [num] */
+ h = caml_hash_mix_uint32(h, Whitehd_hd(Hd_val(v)));
+ /* Mix the code pointers, closure info fields, and infix headers */
+ for (i = 0; i < startenv; i++) {
+ h = caml_hash_mix_intnat(h, Field(v, i));
+ num--;
+ }
+ /* Copy environment fields into queue,
+ not exceeding the total size [sz] */
+ for (/*nothing*/; i < len; i++) {
+ if (wr >= sz) break;
+ queue[wr++] = Field(v, i);
+ }
+ break;
+ }
+#endif
default:
/* Mix in the tag and size, but do not count this towards [num] */
h = caml_hash_mix_uint32(h, Whitehd_hd(Hd_val(v)));
}
break;
}
- } else {
- /* v is a pointer outside the heap, probably a code pointer.
- Shall we count it? Let's say yes by compatibility with old code. */
- h = caml_hash_mix_intnat(h, v);
- num--;
}
}
/* Final mixing of bits */
return Val_int(h & 0x3FFFFFFFU);
}
-/* The old implementation */
-
-struct hash_state {
- uintnat accu;
- intnat univ_limit, univ_count;
-};
-
-static void hash_aux(struct hash_state*, value obj);
-
-CAMLprim value caml_hash_univ_param(value count, value limit, value obj)
-{
- struct hash_state h;
- h.univ_limit = Long_val(limit);
- h.univ_count = Long_val(count);
- h.accu = 0;
- hash_aux(&h, obj);
- return Val_long(h.accu & 0x3FFFFFFF);
- /* The & has two purposes: ensure that the return value is positive
- and give the same result on 32 bit and 64 bit architectures. */
-}
-
-#define Alpha 65599
-#define Beta 19
-#define Combine(new) (h->accu = h->accu * Alpha + (new))
-#define Combine_small(new) (h->accu = h->accu * Beta + (new))
-
-static void hash_aux(struct hash_state* h, value obj)
-{
- unsigned char * p;
- mlsize_t i, j;
- tag_t tag;
-
- h->univ_limit--;
- if (h->univ_count < 0 || h->univ_limit < 0) return;
-
- again:
- if (Is_long(obj)) {
- h->univ_count--;
- Combine(Long_val(obj));
- return;
- }
-
- /* Pointers into the heap are well-structured blocks. So are atoms.
- We can inspect the block contents. */
-
- CAMLassert (Is_block (obj));
- if (Is_in_value_area(obj)) {
- tag = Tag_val(obj);
- switch (tag) {
- case String_tag:
- h->univ_count--;
- i = caml_string_length(obj);
- for (p = &Byte_u(obj, 0); i > 0; i--, p++)
- Combine_small(*p);
- break;
- case Double_tag:
- /* For doubles, we inspect their binary representation, LSB first.
- The results are consistent among all platforms with IEEE floats. */
- h->univ_count--;
-#ifdef ARCH_BIG_ENDIAN
- for (p = &Byte_u(obj, sizeof(double) - 1), i = sizeof(double);
- i > 0;
- p--, i--)
-#else
- for (p = &Byte_u(obj, 0), i = sizeof(double);
- i > 0;
- p++, i--)
-#endif
- Combine_small(*p);
- break;
- case Double_array_tag:
- h->univ_count--;
- for (j = 0; j < Bosize_val(obj); j += sizeof(double)) {
-#ifdef ARCH_BIG_ENDIAN
- for (p = &Byte_u(obj, j + sizeof(double) - 1), i = sizeof(double);
- i > 0;
- p--, i--)
-#else
- for (p = &Byte_u(obj, j), i = sizeof(double);
- i > 0;
- p++, i--)
-#endif
- Combine_small(*p);
- }
- break;
- case Abstract_tag:
- /* We don't know anything about the contents of the block.
- Better do nothing. */
- break;
- case Infix_tag:
- hash_aux(h, obj - Infix_offset_val(obj));
- break;
- case Forward_tag:
- obj = Forward_val (obj);
- goto again;
- case Object_tag:
- h->univ_count--;
- Combine(Oid_val(obj));
- break;
- case Custom_tag:
- /* If no hashing function provided, do nothing */
- if (Custom_ops_val(obj)->hash != NULL) {
- h->univ_count--;
- Combine(Custom_ops_val(obj)->hash(obj));
- }
- break;
- default:
- h->univ_count--;
- Combine_small(tag);
- i = Wosize_val(obj);
- while (i != 0) {
- i--;
- hash_aux(h, Field(obj, i));
- }
- break;
- }
- return;
- }
-
- /* Otherwise, obj is a pointer outside the heap, to an object with
- a priori unknown structure. Use its physical address as hash key. */
- Combine((intnat) obj);
-}
-
/* Hashing variant tags */
CAMLexport value caml_hash_variant(char const * tag)
#if defined(SYS_macosx) || defined(SYS_mingw) || defined(SYS_cygwin)
#define TEXT_SECTION(name)
#else
-#define TEXT_SECTION(name) .section .text.##name,"ax",%progbits
+#define TEXT_SECTION(name) .section .text.caml.##name,"ax",%progbits
#endif
#else
#define TEXT_SECTION(name)
#endif
#define FUNCTION(name) \
- TEXT_SECTION(caml.##name); \
+ TEXT_SECTION(name); \
.globl G(name); \
.align FUNCTION_ALIGN; \
G(name):
#define ALIGN_STACK(amount) subl $ amount, %esp ; CFI_ADJUST(amount)
#define UNDO_ALIGN_STACK(amount) addl $ amount, %esp ; CFI_ADJUST(-amount)
+ .text
#if defined(FUNCTION_SECTIONS)
TEXT_SECTION(caml_hot__code_begin)
.globl G(caml_hot__code_begin)
#endif
/* Allocation */
- .text
+ TEXT_SECTION(caml_system__code_begin)
.globl G(caml_system__code_begin)
G(caml_system__code_begin):
CFI_ENDPROC
ENDFUNCTION(caml_ml_array_bound_error)
+ TEXT_SECTION(caml_system__code_end)
.globl G(caml_system__code_end)
G(caml_system__code_end):
EXTERN _caml_stash_backtrace: PROC
EXTERN _Caml_state: DWORD
+ .CODE
+
+ PUBLIC _caml_system__code_begin
+_caml_system__code_begin:
+ ret ; just one instruction, so that debuggers don't display
+ ; caml_system__code_begin instead of caml_call_gc
; Allocation
- .CODE
PUBLIC _caml_call_gc
PUBLIC _caml_alloc1
PUBLIC _caml_alloc2
mov eax, offset _caml_array_bound_error
jmp _caml_c_call
+ PUBLIC _caml_system__code_end
+_caml_system__code_end:
+
.DATA
PUBLIC _caml_system__frametable
_caml_system__frametable LABEL DWORD
snprintf(buf, sizeof(buf), "%s %d, %d", nam, pc[0], pc[1]);
break;
case SWITCH:
- snprintf(buf, sizeof(buf), "SWITCH sz%#lx=%ld::ntag%ld nint%ld",
+ snprintf(buf, sizeof(buf), "SWITCH sz%#lx=%ld::ntag%lu nint%lu",
(long) pc[0], (long) pc[0], (unsigned long) pc[0] >> 16,
(unsigned long) pc[0] & 0xffff);
break;
} else {
v = Val_hp(intern_dest);
if (intern_obj_table != NULL) intern_obj_table[obj_counter++] = v;
- *intern_dest = Make_header_allocated_here(size, tag, intern_color);
+ *intern_dest = Make_header(size, tag, intern_color);
intern_dest += 1 + size;
/* For objects, we need to freshen the oid */
if (tag == Object_tag) {
size = (len + sizeof(value)) / sizeof(value);
v = Val_hp(intern_dest);
if (intern_obj_table != NULL) intern_obj_table[obj_counter++] = v;
- *intern_dest = Make_header_allocated_here(size, String_tag, intern_color);
+ *intern_dest = Make_header(size, String_tag, intern_color);
intern_dest += 1 + size;
Field(v, size - 1) = 0;
ofs_ind = Bsize_wsize(size) - 1;
case CODE_DOUBLE_BIG:
v = Val_hp(intern_dest);
if (intern_obj_table != NULL) intern_obj_table[obj_counter++] = v;
- *intern_dest = Make_header_allocated_here(Double_wosize, Double_tag,
- intern_color);
+ *intern_dest = Make_header(Double_wosize, Double_tag,
+ intern_color);
intern_dest += 1 + Double_wosize;
readfloat((double *) v, code);
break;
size = len * Double_wosize;
v = Val_hp(intern_dest);
if (intern_obj_table != NULL) intern_obj_table[obj_counter++] = v;
- *intern_dest = Make_header_allocated_here(size, Double_array_tag,
- intern_color);
+ *intern_dest = Make_header(size, Double_array_tag,
+ intern_color);
intern_dest += 1 + size;
readfloats((double *) v, len, code);
break;
size = 1 + (size + sizeof(value) - 1) / sizeof(value);
v = Val_hp(intern_dest);
if (intern_obj_table != NULL) intern_obj_table[obj_counter++] = v;
- *intern_dest = Make_header_allocated_here(size, Custom_tag,
- intern_color);
+ *intern_dest = Make_header(size, Custom_tag,
+ intern_color);
Custom_ops_val(v) = ops;
if (ops->finalize != NULL && Is_young(v)) {
intern_free_stack();
}
-static void intern_alloc(mlsize_t whsize, mlsize_t num_objects,
- int outside_heap)
+static void intern_alloc(mlsize_t whsize, mlsize_t num_objects)
{
mlsize_t wosize;
return;
}
wosize = Wosize_whsize(whsize);
- if (outside_heap || wosize > Max_wosize) {
+ if (wosize > Max_wosize) {
/* Round desired size up to next page */
asize_t request =
((Bsize_wsize(whsize) + Page_size - 1) >> Page_log) << Page_log;
intern_cleanup();
caml_raise_out_of_memory();
}
- intern_color =
- outside_heap ? Caml_black : caml_allocation_color(intern_extra_block);
+ intern_color = caml_allocation_color(intern_extra_block);
intern_dest = (header_t *) intern_extra_block;
CAMLassert (intern_block == 0);
} else {
/* Reading from a channel */
-static value caml_input_val_core(struct channel *chan, int outside_heap)
+value caml_input_val(struct channel *chan)
{
intnat r;
char header[32];
}
/* Initialize global state */
intern_init(block, block);
- intern_alloc(h.whsize, h.num_objects, outside_heap);
+ intern_alloc(h.whsize, h.num_objects);
/* Fill it in */
intern_rec(&res);
- if (!outside_heap)
- return intern_end(res, h.whsize);
- else {
- caml_disown_for_heap(intern_extra_block);
- intern_extra_block = NULL;
- intern_block = 0;
- /* Free everything */
- intern_cleanup();
- return caml_check_urgent_gc(res);
- }
-}
-
-value caml_input_val(struct channel* chan)
-{
- return caml_input_val_core(chan, 0);
+ return intern_end(res, h.whsize);
}
CAMLprim value caml_input_value(value vchan)
/* Reading from memory-resident blocks */
-CAMLprim value caml_input_value_to_outside_heap(value vchan)
-{
- CAMLparam1 (vchan);
- struct channel * chan = Channel(vchan);
- CAMLlocal1 (res);
-
- Lock(chan);
- res = caml_input_val_core(chan, 1);
- Unlock(chan);
- CAMLreturn (res);
-}
-
CAMLexport value caml_input_val_from_bytes(value str, intnat ofs)
{
CAMLparam1 (str);
if (ofs + h.header_len + h.data_len > caml_string_length(str))
caml_failwith("input_val_from_string: bad length");
/* Allocate result */
- intern_alloc(h.whsize, h.num_objects, 0);
+ intern_alloc(h.whsize, h.num_objects);
intern_src = &Byte_u(str, ofs + h.header_len); /* If a GC occurred */
/* Fill it in */
intern_rec(&obj);
CAMLreturn (intern_end(obj, h.whsize));
}
-CAMLprim value caml_input_value_from_string(value str, value ofs)
-{
- return caml_input_val_from_bytes(str, Long_val(ofs));
-}
-
CAMLprim value caml_input_value_from_bytes(value str, value ofs)
{
return caml_input_val_from_bytes(str, Long_val(ofs));
{
value obj;
/* Allocate result */
- intern_alloc(h->whsize, h->num_objects, 0);
+ intern_alloc(h->whsize, h->num_objects);
/* Fill it in */
intern_rec(&obj);
return (intern_end(obj, h->whsize));
}
Instruct(RESTART): {
- int num_args = Wosize_val(env) - 2;
+ int num_args = Wosize_val(env) - 3;
int i;
sp -= num_args;
- for (i = 0; i < num_args; i++) sp[i] = Field(env, i + 2);
- env = Field(env, 1);
+ for (i = 0; i < num_args; i++) sp[i] = Field(env, i + 3);
+ env = Field(env, 2);
extra_args += num_args;
Next;
}
} else {
mlsize_t num_args, i;
num_args = 1 + extra_args; /* arg1 + extra args */
- Alloc_small(accu, num_args + 2, Closure_tag);
- Field(accu, 1) = env;
- for (i = 0; i < num_args; i++) Field(accu, i + 2) = sp[i];
- CAMLassert(!Is_in_value_area(pc-3));
+ Alloc_small(accu, num_args + 3, Closure_tag);
+ Field(accu, 2) = env;
+ for (i = 0; i < num_args; i++) Field(accu, i + 3) = sp[i];
Code_val(accu) = pc - 3; /* Point to the preceding RESTART instr. */
+ Closinfo_val(accu) = Make_closinfo(0, 2);
sp += num_args;
pc = (code_t)(sp[0]);
env = sp[1];
int nvars = *pc++;
int i;
if (nvars > 0) *--sp = accu;
- if (nvars < Max_young_wosize) {
- /* nvars + 1 <= Max_young_wosize, can allocate in minor heap */
- Alloc_small(accu, 1 + nvars, Closure_tag);
- for (i = 0; i < nvars; i++) Field(accu, i + 1) = sp[i];
+ if (nvars <= Max_young_wosize - 2) {
+ /* nvars + 2 <= Max_young_wosize, can allocate in minor heap */
+ Alloc_small(accu, 2 + nvars, Closure_tag);
+ for (i = 0; i < nvars; i++) Field(accu, i + 2) = sp[i];
} else {
/* PR#6385: must allocate in major heap */
/* caml_alloc_shr and caml_initialize never trigger a GC,
so no need to Setup_for_gc */
- accu = caml_alloc_shr(1 + nvars, Closure_tag);
- for (i = 0; i < nvars; i++) caml_initialize(&Field(accu, i + 1), sp[i]);
+ accu = caml_alloc_shr(2 + nvars, Closure_tag);
+ for (i = 0; i < nvars; i++) caml_initialize(&Field(accu, i + 2), sp[i]);
}
/* The code pointer is not in the heap, so no need to go through
caml_initialize. */
- CAMLassert(!Is_in_value_area(pc + *pc));
Code_val(accu) = pc + *pc;
+ Closinfo_val(accu) = Make_closinfo(0, 2);
pc++;
sp += nvars;
Next;
Instruct(CLOSUREREC): {
int nfuncs = *pc++;
int nvars = *pc++;
- mlsize_t blksize = nfuncs * 2 - 1 + nvars;
+ mlsize_t envofs = nfuncs * 3 - 1;
+ mlsize_t blksize = envofs + nvars;
int i;
value * p;
if (nvars > 0) *--sp = accu;
if (blksize <= Max_young_wosize) {
Alloc_small(accu, blksize, Closure_tag);
- p = &Field(accu, nfuncs * 2 - 1);
+ p = &Field(accu, envofs);
for (i = 0; i < nvars; i++, p++) *p = sp[i];
} else {
/* PR#6385: must allocate in major heap */
/* caml_alloc_shr and caml_initialize never trigger a GC,
so no need to Setup_for_gc */
accu = caml_alloc_shr(blksize, Closure_tag);
- p = &Field(accu, nfuncs * 2 - 1);
+ p = &Field(accu, envofs);
for (i = 0; i < nvars; i++, p++) caml_initialize(p, sp[i]);
}
sp += nvars;
/* The code pointers and infix headers are not in the heap,
so no need to go through caml_initialize. */
- p = &Field(accu, 0);
- *p = (value) (pc + pc[0]);
*--sp = accu;
- p++;
+ p = &Field(accu, 0);
+ *p++ = (value) (pc + pc[0]);
+ *p++ = Make_closinfo(0, envofs);
for (i = 1; i < nfuncs; i++) {
- *p = Make_header(i * 2, Infix_tag, Caml_white); /* color irrelevant. */
- p++;
- *p = (value) (pc + pc[i]);
+ *p++ = Make_header(i * 3, Infix_tag, Caml_white); /* color irrelevant */
*--sp = (value) p;
- p++;
+ *p++ = (value) (pc + pc[i]);
+ envofs -= 3;
+ *p++ = Make_closinfo(0, envofs);
}
pc += nfuncs;
Next;
Instruct(OFFSETCLOSURE):
accu = env + *pc++ * sizeof(value); Next;
- Instruct(PUSHOFFSETCLOSUREM2):
+ Instruct(PUSHOFFSETCLOSUREM3):
*--sp = accu; /* fallthrough */
- Instruct(OFFSETCLOSUREM2):
- accu = env - 2 * sizeof(value); Next;
+ Instruct(OFFSETCLOSUREM3):
+ accu = env - 3 * sizeof(value); Next;
Instruct(PUSHOFFSETCLOSURE0):
*--sp = accu; /* fallthrough */
Instruct(OFFSETCLOSURE0):
accu = env; Next;
- Instruct(PUSHOFFSETCLOSURE2):
+ Instruct(PUSHOFFSETCLOSURE3):
*--sp = accu; /* fallthrough */
- Instruct(OFFSETCLOSURE2):
- accu = env + 2 * sizeof(value); Next;
+ Instruct(OFFSETCLOSURE3):
+ accu = env + 3 * sizeof(value); Next;
/* Access to global variables */
Instruct(PUSHTRAP):
sp -= 4;
Trap_pc(sp) = pc + *pc;
- Trap_link(sp) = Caml_state->trapsp;
+ Trap_link_offset(sp) = Val_long(Caml_state->trapsp - sp);
sp[2] = env;
sp[3] = Val_long(extra_args);
Caml_state->trapsp = sp;
pc--; /* restart the POPTRAP after processing the signal */
goto process_actions;
}
- Caml_state->trapsp = Trap_link(sp);
+ Caml_state->trapsp = sp + Long_val(Trap_link_offset(sp));
sp += 4;
Next;
}
sp = Caml_state->trapsp;
pc = Trap_pc(sp);
- Caml_state->trapsp = Trap_link(sp);
+ Caml_state->trapsp = sp + Long_val(Trap_link_offset(sp));
env = sp[2];
extra_args = Long_val(sp[3]);
sp += 4;
#define Lookup(obj, lab) Field (Field (obj, 0), Int_val(lab))
- /* please don't forget to keep below code in sync with the
- functions caml_cache_public_method and
- caml_cache_public_method2 in obj.c */
-
Instruct(GETMETHOD):
accu = Lookup(sp[0], accu);
Next;
}
#endif
}
-
-void caml_prepare_bytecode(code_t prog, asize_t prog_size) {
- /* other implementations of the interpreter (such as an hypothetical
- JIT translator) might want to do something with a bytecode before
- running it */
- CAMLassert(prog);
- CAMLassert(prog_size>0);
- /* actually, the threading of the bytecode might be done here */
-}
-
-void caml_release_bytecode(code_t prog, asize_t prog_size) {
- /* other implementations of the interpreter (such as an hypothetical
- JIT translator) might want to know when a bytecode is removed */
- /* check that we have a program */
- CAMLassert(prog);
- CAMLassert(prog_size>0);
-}
/* Functions shared between input and output */
+static void check_pending(struct channel *channel)
+{
+ if (caml_check_pending_actions()) {
+ /* Temporarily unlock the channel, to ensure locks are not held
+ while any signal handlers (or finalisers, etc) are running */
+ Unlock(channel);
+ caml_process_pending_actions();
+ Lock(channel);
+ }
+}
+
+Caml_inline int descriptor_is_in_binary_mode(int fd)
+{
+#if defined(_WIN32) || defined(__CYGWIN__)
+ int oldmode = setmode(fd, O_TEXT);
+ if (oldmode != -1 && oldmode != O_TEXT) setmode(fd, oldmode);
+ return oldmode == O_BINARY;
+#else
+ return 1;
+#endif
+}
+
CAMLexport struct channel * caml_open_descriptor_in(int fd)
{
struct channel * channel;
channel = (struct channel *) caml_stat_alloc(sizeof(struct channel));
channel->fd = fd;
- caml_enter_blocking_section();
+ caml_enter_blocking_section_no_pending();
channel->offset = lseek(fd, 0, SEEK_CUR);
caml_leave_blocking_section();
channel->curr = channel->max = channel->buff;
channel->revealed = 0;
channel->old_revealed = 0;
channel->refcount = 0;
- channel->flags = 0;
+ channel->flags = descriptor_is_in_binary_mode(fd) ? 0 : CHANNEL_TEXT_MODE;
channel->next = caml_all_opened_channels;
channel->prev = NULL;
channel->name = NULL;
CAMLexport file_offset caml_channel_size(struct channel *channel)
{
- file_offset offset;
- file_offset end;
+ file_offset here, end;
int fd;
+ check_pending(channel);
/* We extract data from [channel] before dropping the OCaml lock, in case
someone else touches the block. */
fd = channel->fd;
- offset = channel->offset;
- caml_enter_blocking_section();
- end = lseek(fd, 0, SEEK_END);
- if (end == -1 || lseek(fd, offset, SEEK_SET) != offset) {
- caml_leave_blocking_section();
- caml_sys_error(NO_ARG);
+ here = channel->flags & CHANNEL_TEXT_MODE ? -1 : channel->offset;
+ caml_enter_blocking_section_no_pending();
+ if (here == -1) {
+ here = lseek(fd, 0, SEEK_CUR);
+ if (here == -1) goto error;
}
+ end = lseek(fd, 0, SEEK_END);
+ if (end == -1) goto error;
+ if (lseek(fd, here, SEEK_SET) != here) goto error;
caml_leave_blocking_section();
return end;
+ error:
+ caml_leave_blocking_section();
+ caml_sys_error(NO_ARG);
}
CAMLexport int caml_channel_binary_mode(struct channel *channel)
{
-#if defined(_WIN32) || defined(__CYGWIN__)
- int oldmode = setmode(channel->fd, O_BINARY);
- if (oldmode == O_TEXT) setmode(channel->fd, O_TEXT);
- return oldmode == O_BINARY;
-#else
- return 1;
-#endif
+ return channel->flags & CHANNEL_TEXT_MODE ? 0 : 1;
}
/* Output */
CAMLexport int caml_flush_partial(struct channel *channel)
{
int towrite, written;
+ again:
+ check_pending(channel);
towrite = channel->curr - channel->buff;
CAMLassert (towrite >= 0);
if (towrite > 0) {
written = caml_write_fd(channel->fd, channel->flags,
channel->buff, towrite);
+ if (written == Io_interrupted) goto again;
channel->offset += written;
if (written < towrite)
memmove(channel->buff, channel->buff + written, towrite - written);
CAMLexport int caml_putblock(struct channel *channel, char *p, intnat len)
{
- int n, free, towrite, written;
+ int n, free;
n = len >= INT_MAX ? INT_MAX : (int) len;
free = channel->end - channel->curr;
/* Write request overflows buffer (or just fills it up): transfer whatever
fits to buffer and write the buffer */
memmove(channel->curr, p, free);
- towrite = channel->end - channel->buff;
- written = caml_write_fd(channel->fd, channel->flags,
- channel->buff, towrite);
- if (written < towrite)
- memmove(channel->buff, channel->buff + written, towrite - written);
- channel->offset += written;
- channel->curr = channel->end - written;
+ channel->curr = channel->end;
+ caml_flush_partial(channel);
return free;
}
}
CAMLexport void caml_seek_out(struct channel *channel, file_offset dest)
{
caml_flush(channel);
- caml_enter_blocking_section();
+ caml_enter_blocking_section_no_pending();
if (lseek(channel->fd, dest, SEEK_SET) != dest) {
caml_leave_blocking_section();
caml_sys_error(NO_ARG);
/* Input */
-/* caml_do_read is exported for Cash */
-CAMLexport int caml_do_read(int fd, char *p, unsigned int n)
+int caml_do_read(int fd, char *p, unsigned int n)
{
- return caml_read_fd(fd, 0, p, n);
+ int r;
+ do {
+ r = caml_read_fd(fd, 0, p, n);
+ } while (r == Io_interrupted);
+ return r;
}
CAMLexport unsigned char caml_refill(struct channel *channel)
{
int n;
-
+ again:
+ check_pending(channel);
n = caml_read_fd(channel->fd, channel->flags,
channel->buff, channel->end - channel->buff);
- if (n == 0) caml_raise_end_of_file();
+ if (n == Io_interrupted) goto again;
+ else if (n == 0) caml_raise_end_of_file();
channel->offset += n;
channel->max = channel->buff + n;
channel->curr = channel->buff + 1;
CAMLexport int caml_getblock(struct channel *channel, char *p, intnat len)
{
int n, avail, nread;
-
+ again:
+ check_pending(channel);
n = len >= INT_MAX ? INT_MAX : (int) len;
avail = channel->max - channel->curr;
if (n <= avail) {
} else {
nread = caml_read_fd(channel->fd, channel->flags, channel->buff,
channel->end - channel->buff);
+ if (nread == Io_interrupted) goto again;
channel->offset += nread;
channel->max = channel->buff + nread;
if (n > nread) n = nread;
CAMLexport void caml_seek_in(struct channel *channel, file_offset dest)
{
- if (dest >= channel->offset - (channel->max - channel->buff) &&
- dest <= channel->offset) {
+ if (dest >= channel->offset - (channel->max - channel->buff)
+ && dest <= channel->offset
+ && (channel->flags & CHANNEL_TEXT_MODE) == 0) {
channel->curr = channel->max - (channel->offset - dest);
} else {
- caml_enter_blocking_section();
+ caml_enter_blocking_section_no_pending();
if (lseek(channel->fd, dest, SEEK_SET) != dest) {
caml_leave_blocking_section();
caml_sys_error(NO_ARG);
return channel->offset - (file_offset)(channel->max - channel->curr);
}
-CAMLexport intnat caml_input_scan_line(struct channel *channel)
+intnat caml_input_scan_line(struct channel *channel)
{
char * p;
int n;
-
+ again:
+ check_pending(channel);
p = channel->curr;
do {
if (p >= channel->max) {
/* Fill the buffer as much as possible */
n = caml_read_fd(channel->fd, channel->flags,
channel->max, channel->end - channel->max);
- if (n == 0) {
+ if (n == Io_interrupted) goto again;
+ else if (n == 0) {
/* End-of-file encountered. Return the number of characters in the
buffer, with negative sign since we haven't encountered
a newline. */
objects into a heap-allocated object. Perform locking
and unlocking around the I/O operations. */
-/* FIXME CAMLexport, but not in io.h exported for Cash ? */
-CAMLexport void caml_finalize_channel(value vchan)
+void caml_finalize_channel(value vchan)
{
struct channel * chan = Channel(vchan);
if ((chan->flags & CHANNEL_FLAG_MANAGED_BY_GC) == 0) return;
channel->curr = channel->max = channel->end;
if (do_syscall) {
- caml_enter_blocking_section();
+ caml_enter_blocking_section_no_pending();
result = close(fd);
caml_leave_blocking_section();
}
#define EOVERFLOW ERANGE
#endif
+static file_offset ml_channel_size(value vchannel)
+{
+ CAMLparam1 (vchannel);
+ struct channel * channel = Channel(vchannel);
+ file_offset size;
+
+ Lock(channel);
+ size = caml_channel_size(Channel(vchannel));
+ Unlock(channel);
+ CAMLreturnT(file_offset, size);
+}
+
CAMLprim value caml_ml_channel_size(value vchannel)
{
- file_offset size = caml_channel_size(Channel(vchannel));
+ file_offset size = ml_channel_size(vchannel);
if (size > Max_long) { errno = EOVERFLOW; caml_sys_error(NO_ARG); }
return Val_long(size);
}
CAMLprim value caml_ml_channel_size_64(value vchannel)
{
- return Val_file_offset(caml_channel_size(Channel(vchannel)));
+ return Val_file_offset(ml_channel_size(vchannel));
}
CAMLprim value caml_ml_set_binary_mode(value vchannel, value mode)
#endif
if (setmode(channel->fd, Bool_val(mode) ? O_BINARY : O_TEXT) == -1)
caml_sys_error(NO_ARG);
+ if (Bool_val(mode))
+ channel->flags &= ~CHANNEL_TEXT_MODE;
+ else
+ channel->flags |= CHANNEL_TEXT_MODE;
#endif
return Val_unit;
}
file descriptors that may be closed.
*/
-CAMLprim value caml_ml_flush_partial(value vchannel)
-{
- CAMLparam1 (vchannel);
- struct channel * channel = Channel(vchannel);
- int res;
-
- if (channel->fd == -1) CAMLreturn(Val_true);
- Lock(channel);
- res = caml_flush_partial(channel);
- Unlock(channel);
- CAMLreturn (Val_bool(res));
-}
-
CAMLprim value caml_ml_flush(value vchannel)
{
CAMLparam1 (vchannel);
CAMLreturn (Val_unit);
}
-CAMLprim value caml_ml_output_partial(value vchannel, value buff, value start,
- value length)
-{
- CAMLparam4 (vchannel, buff, start, length);
- struct channel * channel = Channel(vchannel);
- int res;
-
- Lock(channel);
- res = caml_putblock(channel, &Byte(buff, Long_val(start)), Long_val(length));
- Unlock(channel);
- CAMLreturn (Val_int(res));
-}
-
CAMLprim value caml_ml_output_bytes(value vchannel, value buff, value start,
value length)
{
int n, avail, nread;
Lock(channel);
+ again:
+ check_pending(channel);
/* We cannot call caml_getblock here because buff may move during
caml_read_fd */
start = Long_val(vstart);
} else {
nread = caml_read_fd(channel->fd, channel->flags, channel->buff,
channel->end - channel->buff);
+ if (nread == Io_interrupted) goto again;
channel->offset += nread;
channel->max = channel->buff + nread;
if (n > nread) n = nread;
#include "caml/mlvalues.h"
#include "caml/sys.h"
#include "caml/osdeps.h"
+#include "caml/callback.h"
#ifdef _WIN32
#include <windows.h>
#endif
-CAMLextern void caml_main (char_os **);
-
#ifdef _WIN32
-CAMLextern void caml_expand_command_line (int *, wchar_t ***);
-
int wmain(int argc, wchar_t **argv)
#else
int main(int argc, char **argv)
#include "caml/misc.h"
#include "caml/mlvalues.h"
#include "caml/roots.h"
+#include "caml/skiplist.h"
#include "caml/signals.h"
#include "caml/weak.h"
#include "caml/memprof.h"
#include "caml/eventlog.h"
-#if defined (NATIVE_CODE) && defined (NO_NAKED_POINTERS)
-#define NATIVE_CODE_AND_NO_NAKED_POINTERS
-#else
-#undef NATIVE_CODE_AND_NO_NAKED_POINTERS
-#endif
-
#ifdef _MSC_VER
Caml_inline double fmin(double a, double b) {
return (a < b) ? a : b;
}
#endif
+#define MARK_STACK_INIT_SIZE 2048
+
+typedef struct {
+ value block;
+ uintnat offset;
+} mark_entry;
+
+struct mark_stack {
+ mark_entry* stack;
+ uintnat count;
+ uintnat size;
+};
+
uintnat caml_percent_free;
uintnat caml_major_heap_increment;
CAMLexport char *caml_heap_start;
char *caml_gc_sweep_hp;
int caml_gc_phase; /* always Phase_mark, Pase_clean,
Phase_sweep, or Phase_idle */
-static value *gray_vals;
-static value *gray_vals_cur, *gray_vals_end;
-static asize_t gray_vals_size;
-static int heap_is_pure; /* The heap is pure if the only gray objects
- below [markhp] are also in [gray_vals]. */
uintnat caml_allocated_words;
uintnat caml_dependent_size, caml_dependent_allocated;
double caml_extra_heap_resources;
uintnat caml_fl_wsz_at_phase_change = 0;
-extern char *caml_fl_merge; /* Defined in freelist.c. */
+extern value caml_fl_merge; /* Defined in freelist.c. */
-static char *markhp, *chunk, *limit;
+/* redarken_first_chunk is the first chunk needing redarkening, if NULL no
+ redarkening required */
+static char *redarken_first_chunk = NULL;
+
+static char *sweep_chunk, *sweep_limit;
static double p_backlog = 0.0; /* backlog for the gc speedup parameter */
int caml_gc_subphase; /* Subphase_{mark_roots,mark_main,mark_final} */
*/
static int ephe_list_pure;
/** The ephemerons is pure if since the start of its iteration
- no value have been darken. */
+ no value have been darkened. */
static value *ephes_checked_if_pure;
static value *ephes_to_check;
void (*caml_major_gc_hook)(void) = NULL;
-static void realloc_gray_vals (void)
+/* This function prunes the mark stack if it's about to overflow. It does so
+ by building a skiplist of major heap chunks and then iterating through the
+ mark stack and setting redarken_start/redarken_end on each chunk to indicate
+ the range that requires redarkening. */
+static void mark_stack_prune (struct mark_stack* stk)
+{
+ int entry;
+ uintnat mark_stack_count = stk->count;
+ mark_entry* mark_stack = stk->stack;
+
+ char* heap_chunk = caml_heap_start;
+ struct skiplist chunk_sklist = SKIPLIST_STATIC_INITIALIZER;
+
+ do {
+ caml_skiplist_insert(&chunk_sklist, (uintnat)heap_chunk,
+ (uintnat)(heap_chunk+Chunk_size(heap_chunk)));
+ heap_chunk = Chunk_next(heap_chunk);
+ } while( heap_chunk != NULL );
+
+ 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,
+ &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;
+ }
+
+ if( Chunk_redarken_end(chunk_addr) < block_op ) {
+ Chunk_redarken_end(chunk_addr) = block_op;
+ }
+
+ if( redarken_first_chunk == NULL
+ || redarken_first_chunk > (char*)chunk_addr ) {
+ redarken_first_chunk = (char*)chunk_addr;
+ }
+ }
+ }
+
+ caml_skiplist_empty(&chunk_sklist);
+
+ caml_gc_message(0x08, "Mark stack overflow.\n");
+
+ stk->count = 0;
+}
+
+static void realloc_mark_stack (struct mark_stack* stk)
{
- value *new;
+ mark_entry* new;
+ uintnat mark_stack_bsize = stk->size * sizeof(mark_entry);
- CAMLassert (gray_vals_cur == gray_vals_end);
- if (gray_vals_size < Caml_state->stat_heap_wsz / 32){
- caml_gc_message (0x08, "Growing gray_vals to %"
+ if ( Wsize_bsize(mark_stack_bsize) < Caml_state->stat_heap_wsz / 64 ) {
+ caml_gc_message (0x08, "Growing mark stack to %"
ARCH_INTNAT_PRINTF_FORMAT "uk bytes\n",
- (intnat) gray_vals_size * sizeof (value) / 512);
- new = (value *) caml_stat_resize_noexc ((char *) gray_vals,
- 2 * gray_vals_size *
- sizeof (value));
- if (new == NULL){
- caml_gc_message (0x08, "No room for growing gray_vals\n");
- gray_vals_cur = gray_vals;
- heap_is_pure = 0;
- }else{
- gray_vals = new;
- gray_vals_cur = gray_vals + gray_vals_size;
- gray_vals_size *= 2;
- gray_vals_end = gray_vals + gray_vals_size;
+ (intnat) mark_stack_bsize * 2 / 1024);
+
+ new = (mark_entry*) caml_stat_resize_noexc ((char*) stk->stack,
+ 2 * mark_stack_bsize);
+ if (new != NULL) {
+ stk->stack = new;
+ stk->size *= 2;
+ return;
}
- }else{
- gray_vals_cur = gray_vals + gray_vals_size / 2;
- heap_is_pure = 0;
}
+
+ caml_gc_message (0x08, "No room for growing mark stack. Pruning..\n");
+ mark_stack_prune(stk);
}
-void caml_darken (value v, value *p /* not used */)
+/* This function pushes the provided mark_entry [me] onto the current mark
+ stack [stk]. It first checks, if the block is small enough, whether there
+ are any fields we would actually do mark work on. If so then it enqueues
+ the entry. */
+Caml_inline void mark_stack_push(struct mark_stack* stk, value block,
+ uintnat offset, intnat* work)
{
-#ifdef NATIVE_CODE_AND_NO_NAKED_POINTERS
- if (Is_block (v) && !Is_young (v) && Wosize_val (v) > 0) {
+ value v;
+ int i, block_wsz = Wosize_val(block), end;
+ mark_entry* me;
+
+ CAMLassert(Is_block(block) && Is_in_heap (block)
+ && Is_black_val(block));
+ CAMLassert(Tag_val(block) != Infix_tag);
+ CAMLassert(Tag_val(block) < No_scan_tag);
+
+#if defined(NO_NAKED_POINTERS) || defined(NAKED_POINTERS_CHECKER)
+ if (Tag_val(block) == Closure_tag) {
+ /* Skip the code pointers and integers at beginning of closure;
+ start scanning at the first word of the environment part. */
+ /* It might be the case that [mark_stack_push] has been called
+ while we are traversing a closure block but have not enough
+ budget to finish the block. In that specific case, we should not
+ update [m.offset] */
+ if (offset == 0)
+ offset = Start_env_closinfo(Closinfo_val(block));
+
+ CAMLassert(offset <= Wosize_val(block)
+ && offset >= Start_env_closinfo(Closinfo_val(block)));
+ }
+#endif
+
+ end = (block_wsz < 8 ? block_wsz : 8);
+
+ /* Optimisation to avoid pushing small, unmarkable objects such as [Some 42]
+ * into the mark stack. */
+ for (i = offset; i < end; i++) {
+ v = Field(block, i);
+
+ if (Is_block(v) && !Is_young(v))
+ /* found something to mark */
+ break;
+ }
+
+ if (i == block_wsz) {
+ /* nothing left to mark */
+ if( work != NULL ) {
+ /* we should take credit for it though */
+ *work -= Whsize_wosize(block_wsz - offset);
+ }
+ return;
+ }
+
+ if( work != NULL ) {
+ /* take credit for the work we skipped due to the optimisation.
+ we will take credit for the header later as part of marking. */
+ *work -= (i - offset);
+ }
+
+ offset = i;
+
+ if (stk->count == stk->size)
+ realloc_mark_stack(stk);
+
+ me = &stk->stack[stk->count++];
+
+ me->block = block;
+ me->offset = offset;
+}
+
+#if defined(NAKED_POINTERS_CHECKER) && defined(NATIVE_CODE)
+static void is_naked_pointer_safe (value v, value *p);
+#endif
+
+void caml_darken (value v, value *p)
+{
+#ifdef NO_NAKED_POINTERS
+ if (Is_block(v) && !Is_young (v)) {
#else
- if (Is_block (v) && Is_in_heap (v)) {
+ if (Is_block(v) && Is_in_heap (v)) {
#endif
header_t h = Hd_val (v);
tag_t t = Tag_hd (h);
h = Hd_val (v);
t = Tag_hd (h);
}
-#ifdef NATIVE_CODE_AND_NO_NAKED_POINTERS
+#ifdef NO_NAKED_POINTERS
/* We insist that naked pointers to outside the heap point to things that
- look like values with headers coloured black. This isn't always
- strictly necessary but is essential in certain cases---in particular
- when the value is allocated in a read-only section. (For the values
- where it would be safe it is a performance improvement since we avoid
- putting them on the grey list.) */
+ look like values with headers coloured black. This is always
+ strictly necessary because the compactor relies on it. */
CAMLassert (Is_in_heap (v) || Is_black_hd (h));
#endif
CAMLassert (!Is_blue_hd (h));
if (Is_white_hd (h)){
ephe_list_pure = 0;
+ Hd_val (v) = Blackhd_hd (h);
if (t < No_scan_tag){
- Hd_val (v) = Grayhd_hd (h);
- *gray_vals_cur++ = v;
- if (gray_vals_cur >= gray_vals_end) realloc_gray_vals ();
- }else{
- Hd_val (v) = Blackhd_hd (h);
+ mark_stack_push(Caml_state->mark_stack, v, 0, NULL);
}
}
}
+#if defined(NAKED_POINTERS_CHECKER) && defined(NATIVE_CODE)
+ else if (Is_block(v) && !Is_young(v)) {
+ is_naked_pointer_safe(v, p);
+ }
+#endif
+}
+
+/* This function shrinks the mark stack back to the MARK_STACK_INIT_SIZE size
+ and is called at the end of a GC compaction to avoid a mark stack greater
+ than 1/32th of the heap. */
+void caml_shrink_mark_stack () {
+ struct mark_stack* stk = Caml_state->mark_stack;
+ intnat init_stack_bsize = MARK_STACK_INIT_SIZE * sizeof(mark_entry);
+ mark_entry* shrunk_stack;
+
+ caml_gc_message (0x08, "Shrinking mark stack to %"
+ ARCH_INTNAT_PRINTF_FORMAT "uk bytes\n",
+ init_stack_bsize);
+
+ shrunk_stack = (mark_entry*) caml_stat_resize_noexc ((char*) stk->stack,
+ init_stack_bsize);
+ if (shrunk_stack != NULL) {
+ stk->stack = shrunk_stack;
+ stk->size = MARK_STACK_INIT_SIZE;
+ }else{
+ caml_gc_message (0x08, "Mark stack shrinking failed");
+ }
+}
+
+/* This function adds blocks in the passed heap chunk [heap_chunk] to
+ the mark stack. It returns 1 when the supplied chunk has no more
+ range to redarken. It returns 0 if there are still blocks in the
+ chunk that need redarkening because pushing them onto the stack
+ would make it grow more than a quarter full. This is to lower the
+ chance of triggering another overflow, which would be
+ 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);
+
+ 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);
+ } 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;
+ return 0;
+ }
+ }
+
+ p += Whsize_hp(Hp_op(p));
+ }
+
+ Chunk_redarken_start(heap_chunk) =
+ (value*)(heap_chunk + Chunk_size(heap_chunk));
+
+ Chunk_redarken_end(heap_chunk) = 0;
+ return 1;
}
static void start_cycle (void)
{
CAMLassert (caml_gc_phase == Phase_idle);
- CAMLassert (gray_vals_cur == gray_vals);
+ CAMLassert (Caml_state->mark_stack->count == 0);
+ CAMLassert (redarken_first_chunk == NULL);
caml_gc_message (0x01, "Starting new major GC cycle\n");
caml_darken_all_roots_start ();
caml_gc_phase = Phase_mark;
caml_gc_subphase = Subphase_mark_roots;
- markhp = NULL;
ephe_list_pure = 1;
ephes_checked_if_pure = &caml_ephe_list_head;
ephes_to_check = &caml_ephe_list_head;
#endif
}
-/* We may stop the slice inside values, in order to avoid large latencies
- on large arrays. In this case, [current_value] is the partially-marked
- value and [current_index] is the index of the next field to be marked.
-*/
-static value current_value = 0;
-static mlsize_t current_index = 0;
-
static void init_sweep_phase(void)
{
/* Phase_clean is done. */
caml_gc_sweep_hp = caml_heap_start;
caml_fl_init_merge ();
caml_gc_phase = Phase_sweep;
- chunk = caml_heap_start;
- caml_gc_sweep_hp = chunk;
- limit = chunk + Chunk_size (chunk);
+ sweep_chunk = caml_heap_start;
+ caml_gc_sweep_hp = sweep_chunk;
+ sweep_limit = sweep_chunk + Chunk_size (sweep_chunk);
caml_fl_wsz_at_phase_change = caml_fl_cur_wsz;
if (caml_major_gc_hook) (*caml_major_gc_hook)();
}
/* auxiliary function of mark_slice */
-Caml_inline value* mark_slice_darken(value *gray_vals_ptr,
- value v, mlsize_t i,
- int in_ephemeron, int *slice_pointers)
+Caml_inline void mark_slice_darken(struct mark_stack* stk, value v, mlsize_t i,
+ int in_ephemeron, int *slice_pointers,
+ intnat *work)
{
value child;
header_t chd;
child = Field (v, i);
-#ifdef NATIVE_CODE_AND_NO_NAKED_POINTERS
- if (Is_block (child)
- && ! Is_young (child)
- && Wosize_val (child) > 0 /* Atoms never need to be marked. */
- /* Closure blocks contain code pointers at offsets that cannot
- be reliably determined, so we always use the page table when
- marking such values. */
- && (!(Tag_val (v) == Closure_tag || Tag_val (v) == Infix_tag) ||
- Is_in_heap (child))) {
+#ifdef NO_NAKED_POINTERS
+ if (Is_block (child) && ! Is_young (child)) {
#else
if (Is_block (child) && Is_in_heap (child)) {
#endif
child -= Infix_offset_val(child);
chd = Hd_val(child);
}
-#ifdef NATIVE_CODE_AND_NO_NAKED_POINTERS
+#ifdef NO_NAKED_POINTERS
/* See [caml_darken] for a description of this assertion. */
CAMLassert (Is_in_heap (child) || Is_black_hd (chd));
#endif
if (Is_white_hd (chd)){
ephe_list_pure = 0;
- Hd_val (child) = Grayhd_hd (chd);
- *gray_vals_ptr++ = child;
- if (gray_vals_ptr >= gray_vals_end) {
- gray_vals_cur = gray_vals_ptr;
- realloc_gray_vals ();
- gray_vals_ptr = gray_vals_cur;
+ Hd_val (child) = Blackhd_hd (chd);
+ if( Tag_hd(chd) < No_scan_tag ) {
+ mark_stack_push(stk, child, 0, work);
+ } else {
+ *work -= 1; /* Account for header */
}
}
}
-
- return gray_vals_ptr;
+#if defined(NAKED_POINTERS_CHECKER) && defined(NATIVE_CODE)
+ else if (Is_block(child) && ! Is_young(child)) {
+ is_naked_pointer_safe(child, &Field (v, i));
+ }
+#endif
}
-static value* mark_ephe_aux (value *gray_vals_ptr, intnat *work,
+static void mark_ephe_aux (struct mark_stack *stk, intnat *work,
int *slice_pointers)
{
value v, data, key;
CAMLassert(Tag_val (v) == Abstract_tag);
data = Field(v,CAML_EPHE_DATA_OFFSET);
if ( data != caml_ephe_none &&
- Is_block (data) && Is_in_heap (data) && Is_white_val (data)){
+ Is_block (data) &&
+#ifdef NO_NAKED_POINTERS
+ !Is_young(data) &&
+#else
+ Is_in_heap (data) &&
+#endif
+ Is_white_val (data)){
int alive_data = 1;
key = Field (v, i);
ephemeron_again:
if (key != caml_ephe_none &&
- Is_block (key) && Is_in_heap (key)){
+ Is_block (key) &&
+#ifdef NO_NAKED_POINTERS
+ !Is_young(key)
+#else
+ Is_in_heap(key)
+#endif
+ ){
if (Tag_val (key) == Forward_tag){
value f = Forward_val (key);
if (Is_long (f) ||
*work -= Whsize_wosize(i);
if (alive_data){
- gray_vals_ptr = mark_slice_darken(gray_vals_ptr,v,
- CAML_EPHE_DATA_OFFSET,
- /*in_ephemeron=*/1,
- slice_pointers);
+ mark_slice_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 gray_vals_ptr;
+ return;
}
} else { /* a simily weak pointer or an already alive data */
*work -= 1;
*ephes_checked_if_pure = v;
ephes_checked_if_pure = &Field(v,CAML_EPHE_LINK_OFFSET);
}
- return gray_vals_ptr;
}
-
-
static void mark_slice (intnat work)
{
- value *gray_vals_ptr; /* Local copy of [gray_vals_cur] */
- value v;
- header_t hd;
- mlsize_t size, i, start, end; /* [start] is a local copy of [current_index] */
+ mark_entry me = {0, 0};
+ mlsize_t me_end = 0;
#ifdef CAML_INSTR
int slice_fields = 0; /** eventlog counters */
#endif /*CAML_INSTR*/
int slice_pointers = 0;
+ struct mark_stack* stk = Caml_state->mark_stack;
caml_gc_message (0x40, "Marking %"ARCH_INTNAT_PRINTF_FORMAT"d words\n", work);
caml_gc_message (0x40, "Subphase = %d\n", caml_gc_subphase);
- gray_vals_ptr = gray_vals_cur;
- v = current_value;
- start = current_index;
- while (work > 0){
- if (v == 0 && gray_vals_ptr > gray_vals){
- CAMLassert (start == 0);
- v = *--gray_vals_ptr;
- CAMLassert (Is_gray_val (v));
+
+ 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;
}
- if (v != 0){
- hd = Hd_val(v);
- CAMLassert (Is_gray_hd (hd));
- size = Wosize_hd (hd);
- end = start + work;
- if (Tag_hd (hd) < No_scan_tag){
- start = size < start ? size : start;
- end = size < end ? size : end;
- CAMLassert (end >= start);
+
+ if (work <= 0) {
+ if( can_mark ) {
+ mark_stack_push(stk, me.block, me.offset, NULL);
CAML_EVENTLOG_DO({
- slice_fields += end - start;
- if (size > end)
- CAML_EV_COUNTER (EV_C_MAJOR_MARK_SLICE_REMAIN, size - end);
+ CAML_EV_COUNTER(EV_C_MAJOR_MARK_SLICE_REMAIN, me_end - me.offset);
});
- for (i = start; i < end; i++){
- gray_vals_ptr = mark_slice_darken(gray_vals_ptr,v,i,
- /*in_ephemeron=*/ 0,
- &slice_pointers);
- }
- if (end < size){
- work = 0;
- start = end;
- /* [v] doesn't change. */
- CAMLassert (Is_gray_val (v));
- }else{
- CAMLassert (end == size);
- Hd_val (v) = Blackhd_hd (hd);
- work -= Whsize_wosize(end - start);
- start = 0;
- v = 0;
- }
- }else{
- /* The block doesn't contain any pointers. */
- CAMLassert (start == 0);
- Hd_val (v) = Blackhd_hd (hd);
- work -= Whsize_wosize(size);
- v = 0;
}
- }else if (markhp != NULL){
- if (markhp == limit){
- chunk = Chunk_next (chunk);
- if (chunk == NULL){
- markhp = NULL;
- }else{
- markhp = chunk;
- limit = chunk + Chunk_size (chunk);
- }
- }else{
- if (Is_gray_val (Val_hp (markhp))){
- CAMLassert (gray_vals_ptr == gray_vals);
- CAMLassert (v == 0 && start == 0);
- v = Val_hp (markhp);
- }
- markhp += Bhsize_hp (markhp);
+ 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);
+
+ work--;
+
+ CAML_EVENTLOG_DO({
+ slice_fields++;
+ });
+
+ if( me.offset == me_end ) {
+ work--; /* Include header word */
+ }
+ } else 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) ) {
+ redarken_first_chunk = Chunk_next(redarken_first_chunk);
}
- }else if (!heap_is_pure){
- heap_is_pure = 1;
- chunk = caml_heap_start;
- markhp = chunk;
- limit = chunk + Chunk_size (chunk);
} else if (caml_gc_subphase == Subphase_mark_roots) {
CAML_EV_BEGIN(EV_MAJOR_MARK_ROOTS);
- gray_vals_cur = gray_vals_ptr;
work = caml_darken_all_roots_slice (work);
- gray_vals_ptr = gray_vals_cur;
CAML_EV_END(EV_MAJOR_MARK_ROOTS);
if (work > 0){
caml_gc_subphase = Subphase_mark_main;
}
} else if (*ephes_to_check != (value) NULL) {
/* Continue to scan the list of ephe */
- gray_vals_ptr = mark_ephe_aux(gray_vals_ptr,&work,&slice_pointers);
+ mark_ephe_aux(stk,&work,&slice_pointers);
} else if (!ephe_list_pure){
/* We must scan again the list because some value have been darken */
ephe_list_pure = 1;
/* Subphase_mark_main is done.
Mark finalised values. */
CAML_EV_BEGIN(EV_MAJOR_MARK_MAIN);
- gray_vals_cur = gray_vals_ptr;
caml_final_update_mark_phase ();
- gray_vals_ptr = gray_vals_cur;
- if (gray_vals_ptr > gray_vals){
- v = *--gray_vals_ptr;
- CAMLassert (start == 0);
- }
/* Complete the marking */
ephes_to_check = ephes_checked_if_pure;
CAML_EV_END(EV_MAJOR_MARK_MAIN);
}
}
}
- gray_vals_cur = gray_vals_ptr;
- current_value = v;
- current_index = start;
CAML_EV_COUNTER(EV_C_MAJOR_MARK_SLICE_FIELDS, slice_fields);
CAML_EV_COUNTER(EV_C_MAJOR_MARK_SLICE_POINTERS, slice_pointers);
}
caml_gc_message (0x40, "Sweeping %"
ARCH_INTNAT_PRINTF_FORMAT "d words\n", work);
while (work > 0){
- if (caml_gc_sweep_hp < limit){
+ if (caml_gc_sweep_hp < sweep_limit){
hp = caml_gc_sweep_hp;
hd = Hd_hp (hp);
work -= Whsize_hd (hd);
caml_gc_sweep_hp += Bhsize_hd (hd);
switch (Color_hd (hd)){
case Caml_white:
- caml_gc_sweep_hp = (char *) caml_fl_merge_block (Val_hp (hp), limit);
+ caml_gc_sweep_hp =
+ (char *)caml_fl_merge_block(Val_hp (hp), sweep_limit);
break;
case Caml_blue:
/* Only the blocks of the free-list are blue. See [freelist.c]. */
- caml_fl_merge = Bp_hp (hp);
+ caml_fl_merge = (value) Bp_hp (hp);
break;
default: /* gray or black */
CAMLassert (Color_hd (hd) == Caml_black);
Hd_hp (hp) = Whitehd_hd (hd);
break;
}
- CAMLassert (caml_gc_sweep_hp <= limit);
+ CAMLassert (caml_gc_sweep_hp <= sweep_limit);
}else{
- chunk = Chunk_next (chunk);
- if (chunk == NULL){
+ sweep_chunk = Chunk_next (sweep_chunk);
+ if (sweep_chunk == NULL){
/* Sweeping is done. */
++ Caml_state->stat_major_collections;
work = 0;
caml_gc_phase = Phase_idle;
caml_request_minor_gc ();
}else{
- caml_gc_sweep_hp = chunk;
- limit = chunk + Chunk_size (chunk);
+ caml_gc_sweep_hp = sweep_chunk;
+ sweep_limit = sweep_chunk + Chunk_size (sweep_chunk);
}
}
}
while (caml_gc_phase == Phase_mark) mark_slice (LONG_MAX);
while (caml_gc_phase == Phase_clean) clean_slice (LONG_MAX);
CAMLassert (caml_gc_phase == Phase_sweep);
+ CAMLassert (redarken_first_chunk == NULL);
while (caml_gc_phase == Phase_sweep) sweep_slice (LONG_MAX);
CAMLassert (caml_gc_phase == Phase_idle);
Caml_state->stat_major_words += caml_allocated_words;
caml_make_free_blocks ((value *) caml_heap_start,
Caml_state->stat_heap_wsz, 1, Caml_white);
caml_gc_phase = Phase_idle;
- gray_vals_size = 2048;
- gray_vals = (value *) caml_stat_alloc_noexc (gray_vals_size * sizeof (value));
- if (gray_vals == NULL)
- caml_fatal_error ("not enough memory for the gray cache");
- gray_vals_cur = gray_vals;
- gray_vals_end = gray_vals + gray_vals_size;
- heap_is_pure = 1;
+
+ Caml_state->mark_stack = caml_stat_alloc_noexc(sizeof(struct mark_stack));
+ if (Caml_state->mark_stack == NULL)
+ caml_fatal_error ("not enough memory for the mark stack");
+
+ Caml_state->mark_stack->stack =
+ caml_stat_alloc_noexc(MARK_STACK_INIT_SIZE * sizeof(mark_entry));
+
+ if(Caml_state->mark_stack->stack == NULL)
+ caml_fatal_error("not enough memory for the mark stack");
+
+ Caml_state->mark_stack->count = 0;
+ Caml_state->mark_stack->size = MARK_STACK_INIT_SIZE;
+
caml_allocated_words = 0;
caml_extra_heap_resources = 0.0;
for (i = 0; i < Max_major_window; i++) caml_major_ring[i] = 0.0;
{
/* Finishing major cycle (all values become white) */
caml_empty_minor_heap ();
+ caml_gc_message (0x1, "Finishing major GC cycle (finalising heap)\n");
caml_finish_major_cycle ();
CAMLassert (caml_gc_phase == Phase_idle);
/* Finalising all values (by means of forced sweeping) */
caml_fl_init_merge ();
caml_gc_phase = Phase_sweep;
- chunk = caml_heap_start;
- caml_gc_sweep_hp = chunk;
- limit = chunk + Chunk_size (chunk);
+ sweep_chunk = caml_heap_start;
+ caml_gc_sweep_hp = sweep_chunk;
+ sweep_limit = sweep_chunk + Chunk_size (sweep_chunk);
while (caml_gc_phase == Phase_sweep)
sweep_slice (LONG_MAX);
}
+
+#if defined(NAKED_POINTERS_CHECKER) && defined(NATIVE_CODE)
+
+#ifdef _WIN32
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+
+Caml_inline int safe_load(volatile header_t * p, header_t * result)
+{
+ header_t v;
+ __try {
+ v = *p;
+ }
+ __except(GetExceptionCode() == EXCEPTION_ACCESS_VIOLATION ?
+ EXCEPTION_EXECUTE_HANDLER : EXCEPTION_CONTINUE_SEARCH) {
+ *result = 0xdeadbeef;
+ return 0;
+ }
+ *result = v;
+ return 1;
+}
+
+#else
+
+Caml_inline int safe_load (header_t * addr, /*out*/ header_t * contents)
+{
+ int ok;
+ header_t h;
+ intnat tmp;
+
+ asm volatile(
+ "leaq 1f(%%rip), %[tmp] \n\t"
+ "movq %[tmp], 0(%[handler]) \n\t"
+ "xorl %[ok], %[ok] \n\t"
+ "movq 0(%[addr]), %[h] \n\t"
+ "movl $1, %[ok] \n\t"
+ "1: \n\t"
+ "xorq %[tmp], %[tmp] \n\t"
+ "movq %[tmp], 0(%[handler])"
+ : [tmp] "=&r" (tmp), [ok] "=&r" (ok), [h] "=&r" (h)
+ : [addr] "r" (addr),
+ [handler] "r" (&(Caml_state->checking_pointer_pc)));
+ *contents = h;
+ return ok;
+}
+
+#endif
+
+static void is_naked_pointer_safe (value v, value *p)
+{
+ header_t h;
+ tag_t t;
+
+ /* The following conditions were checked by the caller */
+ CAMLassert(Is_block(v) && !Is_young(v) && !Is_in_heap(v));
+
+ if (! safe_load(&Hd_val(v), &h)) goto on_segfault;
+
+ t = Tag_hd(h);
+ if (t == Infix_tag) {
+ v -= Infix_offset_hd(h);
+ if (! safe_load(&Hd_val(v), &h)) goto on_segfault;
+ t = Tag_hd(h);
+ }
+
+ /* For the out-of-heap pointer to be considered safe,
+ * it should have a black header and its size should be < 2 ** 40
+ * words (128 GB). If not, we report a warning. */
+ if (Is_black_hd(h) && Wosize_hd(h) < (INT64_LITERAL(1) << 40))
+ return;
+
+ if (!Is_black_hd(h)) {
+ fprintf (stderr, "Out-of-heap pointer at %p of value %p has "
+ "non-black head (tag=%d)\n", p, (void*)v, t);
+ } else {
+ fprintf (stderr,
+ "Out-of-heap pointer at %p of value %p has "
+ "suspiciously large size: %" ARCH_INT64_PRINTF_FORMAT "u words\n",
+ p, (void*)v, Wosize_hd(h));
+ }
+ return;
+
+ on_segfault:
+ fprintf (stderr, "Out-of-heap pointer at %p of value %p. "
+ "Cannot read head.\n", p, (void*)v);
+}
+
+#endif
/* Page table management */
#define Page(p) ((uintnat) (p) >> Page_log)
-#define Page_mask ((uintnat) -1 << Page_log)
+#define Page_mask ((~(uintnat)0) << Page_log)
#ifdef ARCH_SIXTYFOUR
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;
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;
}
}
-/* Use this function if a block allocated with [caml_alloc_for_heap] is
- not actually going to be added to the heap. The caller is responsible
- for freeing it. */
-void caml_disown_for_heap (char* mem)
-{
- /* Currently a no-op. */
- (void)mem; /* can CAMLunused_{start,end} be used here? */
-}
-
/* Use this function to free a block allocated with [caml_alloc_for_heap]
if you don't add it with [caml_add_to_heap].
*/
}else{
Field (Val_hp (prev), 0) = (value) NULL;
if (remain == 1) {
- Hd_hp (hp) = Make_header_allocated_here (0, 0, Caml_white);
+ Hd_hp (hp) = Make_header (0, 0, Caml_white);
}
}
CAMLassert (Wosize_hp (mem) >= request);
Caml_state->stat_heap_wsz -= Wsize_bsize (Chunk_size (chunk));
caml_gc_message (0x04, "Shrinking heap to %"
- ARCH_INTNAT_PRINTF_FORMAT "uk words\n",
+ ARCH_INTNAT_PRINTF_FORMAT "dk words\n",
Caml_state->stat_heap_wsz / 1024);
#ifdef DEBUG
caml_free_for_heap (chunk);
}
-color_t caml_allocation_color (void *hp)
+CAMLexport color_t caml_allocation_color (void *hp)
{
if (caml_gc_phase == Phase_mark || caml_gc_phase == Phase_clean ||
(caml_gc_phase == Phase_sweep && (char *)hp >= (char *)caml_gc_sweep_hp)){
}
#endif /* WITH_PROFINFO */
-#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
-#include "caml/spacetime.h"
-
-CAMLexport value caml_alloc_shr (mlsize_t wosize, tag_t tag)
-{
- return caml_alloc_shr_with_profinfo (wosize, tag,
- caml_spacetime_my_profinfo (NULL, wosize));
-}
-
-CAMLexport value caml_alloc_shr_no_track_noexc (mlsize_t wosize, tag_t tag)
-{
- return caml_alloc_shr_aux (wosize, tag, 0, 0,
- caml_spacetime_my_profinfo (NULL, wosize));
-}
-#else
CAMLexport value caml_alloc_shr (mlsize_t wosize, tag_t tag)
{
return caml_alloc_shr_aux (wosize, tag, 1, 1, NO_PROFINFO);
{
return caml_alloc_shr_aux (wosize, tag, 0, 0, NO_PROFINFO);
}
-#endif
/* Dependent memory is all memory blocks allocated out of the heap
that depend on the GC (and finalizers) for deallocation.
#define CAML_INTERNALS
-#include <math.h>
#include <string.h>
#include "caml/memprof.h"
#include "caml/fail.h"
#include "caml/printexc.h"
#include "caml/eventlog.h"
-#define MT_STATE_SIZE 624
+#define RAND_BLOCK_SIZE 64
-static uint32_t mt_state[MT_STATE_SIZE];
-static uint32_t mt_index;
+static uint32_t xoshiro_state[4][RAND_BLOCK_SIZE];
+static uintnat rand_geom_buff[RAND_BLOCK_SIZE];
+static uint32_t rand_pos;
/* [lambda] is the mean number of samples for each allocated word (including
block headers). */
static double lambda = 0;
- /* Precomputed value of [1/log(1-lambda)], for fast sampling of
- geometric distribution.
- Dummy if [lambda = 0]. */
-static double one_log1m_lambda;
-
-/* [caml_memprof_suspended] is used for masking memprof callbacks when
- a callback is running or when an uncaught exception handler is
- called. */
-int caml_memprof_suspended = 0;
-
-/* [callback_running] is used to trigger a fatal error whenever
- [Thread.exit] is called from a callback. */
-static int callback_running = 0;
+/* Precomputed value of [1/log(1-lambda)], for fast sampling of
+ geometric distribution.
+ Dummy if [lambda = 0]. */
+static float one_log1m_lambda;
static intnat callstack_size;
static value tracker;
+/* Gc.Memprof.allocation_source */
+enum { SRC_NORMAL = 0, SRC_MARSHAL = 1, SRC_CUSTOM = 2 };
+
+struct tracked {
+ /* Memory block being sampled. This is a weak GC root. */
+ value block;
+
+ /* Number of samples in this block. */
+ uintnat n_samples;
+
+ /* The size of this block. */
+ uintnat wosize;
+
+ /* The value returned by the previous callback for this block, or
+ the callstack if the alloc callback has not been called yet.
+ This is a strong GC root. */
+ value user_data;
+
+ /* The thread currently running a callback for this entry,
+ or NULL if there is none */
+ struct caml_memprof_th_ctx* running;
+
+ /* Whether this block has been initially allocated in the minor heap. */
+ unsigned int alloc_young : 1;
+
+ /* The source of the allocation: normal allocations, marshal or custom_mem. */
+ unsigned int source : 2;
+
+ /* Whether this block has been promoted. Implies [alloc_young]. */
+ unsigned int promoted : 1;
+
+ /* Whether this block has been deallocated. */
+ unsigned int deallocated : 1;
+
+ /* Whether the allocation callback has been called depends on
+ whether the entry is in a thread local entry array or in
+ [entries_global]. */
+
+ /* Whether the promotion callback has been called. */
+ unsigned int cb_promote_called : 1;
+
+ /* Whether the deallocation callback has been called. */
+ unsigned int cb_dealloc_called : 1;
+
+ /* Whether this entry is deleted. */
+ unsigned int deleted : 1;
+};
+
+/* During the alloc callback for a minor allocation, the block being
+ sampled is not yet allocated. Instead, we place in the block field
+ a value computed with the following macro: */
+#define Placeholder_magic 0x04200000
+#define Placeholder_offs(offset) (Val_long(offset + Placeholder_magic))
+#define Offs_placeholder(block) (Long_val(block) & 0xFFFF)
+#define Is_placeholder(block) \
+ (Is_long(block) && (Long_val(block) & ~(uintnat)0xFFFF) == Placeholder_magic)
+
+/* A resizable array of entries */
+struct entry_array {
+ struct tracked* t;
+ uintnat min_alloc_len, alloc_len, len;
+ /* Before this position, the [block] and [user_data] fields point to
+ the major heap ([young <= len]). */
+ uintnat young_idx;
+ /* There are no blocks to be deleted before this position
+ ([delete_idx <= len]). */
+ uintnat delete_idx;
+};
+
+#define MIN_ENTRIES_LOCAL_ALLOC_LEN 16
+#define MIN_ENTRIES_GLOBAL_ALLOC_LEN 128
+
+/* Entries for other blocks. This variable is shared accross threads. */
+static struct entry_array entries_global =
+ { NULL, MIN_ENTRIES_GLOBAL_ALLOC_LEN, 0, 0, 0, 0 };
+
+/* There are no pending callbacks in [entries_global] before this
+ position ([callback_idx <= entries_global.len]). */
+static uintnat callback_idx;
+
+#define CB_IDLE -1
+#define CB_LOCAL -2
+#define CB_STOPPED -3
+
+/* Structure for thread-local variables. */
+struct caml_memprof_th_ctx {
+ /* [suspended] is used for masking memprof callbacks when
+ a callback is running or when an uncaught exception handler is
+ called. */
+ int suspended;
+
+ /* [callback_status] contains:
+ - CB_STOPPED if the current thread is running a callback, but
+ sampling has been stopped using [caml_memprof_stop];
+ - The index of the corresponding entry in the [entries_global]
+ array if the current thread is currently running a promotion or
+ a deallocation callback;
+ - CB_LOCAL if the current thread is currently running an
+ allocation callback;
+ - CB_IDLE if the current thread is not running any callback.
+ */
+ intnat callback_status;
+
+ /* Entries for blocks whose alloc callback has not yet been called. */
+ struct entry_array entries;
+} caml_memprof_main_ctx =
+ { 0, CB_IDLE, { NULL, MIN_ENTRIES_LOCAL_ALLOC_LEN, 0, 0, 0, 0 } };
+static struct caml_memprof_th_ctx* local = &caml_memprof_main_ctx;
/* Pointer to the word following the next sample in the minor
heap. Equals [Caml_state->young_alloc_start] if no sampling is planned in
/**** Statistical sampling ****/
-static double mt_generate_uniform(void)
+Caml_inline uint64_t splitmix64_next(uint64_t* x)
{
- int i;
- uint32_t y;
+ uint64_t z = (*x += 0x9E3779B97F4A7C15ull);
+ z = (z ^ (z >> 30)) * 0xBF58476D1CE4E5B9ull;
+ z = (z ^ (z >> 27)) * 0x94D049BB133111EBull;
+ return z ^ (z >> 31);
+}
- /* Mersenne twister PRNG */
- if (mt_index == MT_STATE_SIZE) {
- for (i = 0; i < 227; i++) {
- y = (mt_state[i] & 0x80000000) + (mt_state[i+1] & 0x7fffffff);
- mt_state[i] = mt_state[i+397] ^ (y >> 1) ^ ((-(y&1)) & 0x9908b0df);
- }
- for (i = 227; i < MT_STATE_SIZE - 1; i++) {
- y = (mt_state[i] & 0x80000000) + (mt_state[i+1] & 0x7fffffff);
- mt_state[i] = mt_state[i-227] ^ (y >> 1) ^ ((-(y&1)) & 0x9908b0df);
- }
- y = (mt_state[MT_STATE_SIZE - 1] & 0x80000000) + (mt_state[0] & 0x7fffffff);
- mt_state[MT_STATE_SIZE - 1] =
- mt_state[396] ^ (y >> 1) ^ ((-(y&1)) & 0x9908b0df);
- mt_index = 0;
+static void xoshiro_init(void)
+{
+ int i;
+ uint64_t splitmix64_state = 42;
+ rand_pos = RAND_BLOCK_SIZE;
+ for (i = 0; i < RAND_BLOCK_SIZE; i++) {
+ uint64_t t = splitmix64_next(&splitmix64_state);
+ xoshiro_state[0][i] = t & 0xFFFFFFFF;
+ xoshiro_state[1][i] = t >> 32;
+ t = splitmix64_next(&splitmix64_state);
+ xoshiro_state[2][i] = t & 0xFFFFFFFF;
+ xoshiro_state[3][i] = t >> 32;
}
+}
+
+Caml_inline uint32_t xoshiro_next(int i)
+{
+ uint32_t res = xoshiro_state[0][i] + xoshiro_state[3][i];
+ uint32_t t = xoshiro_state[1][i] << 9;
+ xoshiro_state[2][i] ^= xoshiro_state[0][i];
+ xoshiro_state[3][i] ^= xoshiro_state[1][i];
+ xoshiro_state[1][i] ^= xoshiro_state[2][i];
+ xoshiro_state[0][i] ^= xoshiro_state[3][i];
+ xoshiro_state[2][i] ^= t;
+ t = xoshiro_state[3][i];
+ xoshiro_state[3][i] = (t << 11) | (t >> 21);
+ return res;
+}
+
+/* Computes [log((y+0.5)/2^32)], up to a relatively good precision,
+ and guarantee that the result is negative.
+ The average absolute error is very close to 0. */
+Caml_inline float log_approx(uint32_t y)
+{
+ union { float f; int32_t i; } u;
+ float exp, x;
+ u.f = y + 0.5f; /* We convert y to a float ... */
+ exp = u.i >> 23; /* ... of which we extract the exponent ... */
+ u.i = (u.i & 0x7FFFFF) | 0x3F800000;
+ x = u.f; /* ... and the mantissa. */
+
+ return
+ /* This polynomial computes the logarithm of the mantissa (which
+ is in [1, 2]), up to an additive constant. It is chosen such that :
+ - Its degree is 4.
+ - Its average value is that of log in [1, 2]
+ (the sampling has the right mean when lambda is small).
+ - f(1) = f(2) - log(2) = -159*log(2) - 1e-5
+ (this guarantee that log_approx(y) is always <= -1e-5 < 0).
+ - The maximum of abs(f(x)-log(x)+159*log(2)) is minimized.
+ */
+ x * (2.104659476859f + x * (-0.720478916626f + x * 0.107132064797f))
+
+ /* Then, we add the term corresponding to the exponent, and
+ additive constants. */
+ + (-111.701724334061f + 0.6931471805f*exp);
+}
+
+/* This function regenerates [MT_STATE_SIZE] geometric random
+ variables at once. Doing this by batches help us gain performances:
+ many compilers (e.g., GCC, CLang, ICC) will be able to use SIMD
+ instructions to get a performance boost.
+*/
+#ifdef SUPPORTS_TREE_VECTORIZE
+__attribute__((optimize("tree-vectorize")))
+#endif
+static void rand_batch(void)
+{
+ int i;
- y = mt_state[mt_index];
- y = y ^ (y >> 11);
- y = y ^ ((y << 7) & 0x9d2c5680);
- y = y ^ ((y << 15) & 0xefc60000);
- y = y ^ (y >> 18);
+ /* Instead of using temporary buffers, we could use one big loop,
+ but it turns out SIMD optimizations of compilers are more fragile
+ when using larger loops. */
+ static uint32_t A[RAND_BLOCK_SIZE];
+ static float B[RAND_BLOCK_SIZE];
+
+ CAMLassert(lambda > 0.);
+
+ /* Shuffle the xoshiro samplers, and generate uniform variables in A. */
+ for (i = 0; i < RAND_BLOCK_SIZE; i++)
+ A[i] = xoshiro_next(i);
+
+ /* Generate exponential random variables by computing logarithms. We
+ do not use math.h library functions, which are slow and prevent
+ compiler from using SIMD instructions. */
+ for (i = 0; i < RAND_BLOCK_SIZE; i++)
+ B[i] = 1 + log_approx(A[i]) * one_log1m_lambda;
+
+ /* We do the final flooring for generating geometric
+ variables. Compilers are unlikely to use SIMD instructions for
+ this loop, because it involves a conditional and variables of
+ different sizes (32 and 64 bits). */
+ for (i = 0; i < RAND_BLOCK_SIZE; i++) {
+ double f = B[i];
+ CAMLassert (f >= 1);
+ /* [Max_long+1] is a power of two => no rounding in the test. */
+ if (f >= Max_long+1)
+ rand_geom_buff[i] = Max_long;
+ else rand_geom_buff[i] = (uintnat)f;
+ }
- mt_index++;
- return y*2.3283064365386962890625e-10 + /* 2^-32 */
- 1.16415321826934814453125e-10; /* 2^-33 */
+ rand_pos = 0;
}
/* Simulate a geometric variable of parameter [lambda].
The result is clipped in [1..Max_long] */
-static uintnat mt_generate_geom(void)
+static uintnat rand_geom(void)
{
- double res;
+ uintnat res;
CAMLassert(lambda > 0.);
- /* We use the float versions of exp/log, since these functions are
- significantly faster, and we really don't need much precision
- here. The entropy contained in [next_mt_generate_geom] is anyway
- bounded by the entropy provided by [mt_generate_uniform], which
- is 32bits. */
- res = 1 + logf(mt_generate_uniform()) * one_log1m_lambda;
- if (res > Max_long) return Max_long;
- return (uintnat)res;
+ if (rand_pos == RAND_BLOCK_SIZE) rand_batch();
+ res = rand_geom_buff[rand_pos++];
+ CAMLassert(1 <= res && res <= Max_long);
+ return res;
}
-static uintnat next_mt_generate_geom;
+static uintnat next_rand_geom;
/* Simulate a binomial variable of parameters [len] and [lambda].
This sampling algorithm has running time linear with [len *
lambda]. We could use more a involved algorithm, but this should
Hormann, Wolfgang. "The generation of binomial random variates."
Journal of statistical computation and simulation 46.1-2 (1993), pp101-110.
*/
-static uintnat mt_generate_binom(uintnat len)
+static uintnat rand_binom(uintnat len)
{
uintnat res;
CAMLassert(lambda > 0. && len < Max_long);
- for (res = 0; next_mt_generate_geom < len; res++)
- next_mt_generate_geom += mt_generate_geom();
- next_mt_generate_geom -= len;
+ for (res = 0; next_rand_geom < len; res++)
+ next_rand_geom += rand_geom();
+ next_rand_geom -= len;
return res;
}
/* In this version, we are allowed to call the GC, so we use
[caml_alloc], which is more efficient since it uses the minor
heap.
- Should be called with [caml_memprof_suspended == 1] */
+ Should be called with [local->suspended == 1] */
static value capture_callstack(int alloc_idx)
{
value res;
intnat callstack_len =
caml_collect_current_callstack(&callstack_buffer, &callstack_buffer_len,
callstack_size, alloc_idx);
- CAMLassert(caml_memprof_suspended);
+ CAMLassert(local->suspended);
res = caml_alloc(callstack_len, 0);
memcpy(Op_val(res), callstack_buffer, sizeof(value) * callstack_len);
if (callstack_buffer_len > 256 && callstack_buffer_len > callstack_len * 8) {
return res;
}
-/**** Data structures for tracked blocks. ****/
-
-struct tracked {
- /* Memory block being sampled. This is a weak GC root. */
- value block;
-
- /* Number of samples in this block. */
- uintnat n_samples;
-
- /* The size of this block. */
- uintnat wosize;
-
- /* The value returned by the previous callback for this block, or
- the callstack if the alloc callback has not been called yet.
- This is a strong GC root. */
- value user_data;
-
- /* Whether this block has been initially allocated in the minor heap. */
- unsigned int alloc_young : 1;
-
- /* Whether this block comes from unmarshalling. */
- unsigned int unmarshalled : 1;
-
- /* Whether this block has been promoted. Implies [alloc_young]. */
- unsigned int promoted : 1;
-
- /* Whether this block has been deallocated. */
- unsigned int deallocated : 1;
-
- /* Whether the allocation callback has been called. */
- unsigned int cb_alloc_called : 1;
-
- /* Whether the promotion callback has been called. */
- unsigned int cb_promote_called : 1;
-
- /* Whether the deallocation callback has been called. */
- unsigned int cb_dealloc_called : 1;
-
- /* Whether this entry is deleted. */
- unsigned int deleted : 1;
-
- /* Whether a callback is currently running for this entry. */
- unsigned int callback_running : 1;
-
- /* Pointer to the [t_idx] variable in the [run_callback] frame which
- is currently running the callback for this entry. This is needed
- to make [run_callback] reetrant, in the case it is called
- simultaneously by several threads. */
- uintnat* idx_ptr;
-};
-
-/* During the alloc callback for a minor allocation, the block being
- sampled is not yet allocated. Instead, we place in the block field
- a value computed with the following macro: */
-#define Placeholder_magic 0x04200000
-#define Placeholder_offs(offset) (Val_long(offset + Placeholder_magic))
-#define Offs_placeholder(block) (Long_val(block) & 0xFFFF)
-#define Is_placeholder(block) \
- (Is_long(block) && (Long_val(block) & ~(uintnat)0xFFFF) == Placeholder_magic)
-
-/* When an entry is deleted, its index is replaced by that integer. */
-#define Invalid_index (~(uintnat)0)
-
-
-static struct tracking_state {
- struct tracked* entries;
- /* The allocated capacity of the entries array */
- uintnat alloc_len;
- /* The number of active entries. (len <= alloc_len) */
- uintnat len;
- /* Before this position, the [block] and [user_data] fields point to
- the major heap (young <= len). */
- uintnat young;
- /* There are no pending callbacks before this position (callback <= len). */
- uintnat callback;
- /* There are no blocks to be deleted before this position */
- uintnat delete;
-} trackst;
-
-#define MIN_TRACKST_ALLOC_LEN 128
-
+/**** Managing data structures for tracked blocks. ****/
-/* Reallocate the [trackst] array if it is either too small or too
+/* Reallocate the [ea] array if it is either too small or too
large.
- Returns 1 if reallocation succeeded --[trackst.alloc_len] is at
- least [trackst.len]--, and 0 otherwise. */
-static int realloc_trackst(void) {
- uintnat new_alloc_len;
- struct tracked* new_entries;
- if (trackst.len <= trackst.alloc_len &&
- (4*trackst.len >= trackst.alloc_len ||
- trackst.alloc_len == MIN_TRACKST_ALLOC_LEN))
+ [grow] is the number of free cells needed.
+ Returns 1 if reallocation succeeded --[ea->alloc_len] is at
+ least [ea->len+grow]--, and 0 otherwise. */
+static int realloc_entries(struct entry_array* ea, uintnat grow)
+{
+ uintnat new_alloc_len, new_len = ea->len + grow;
+ struct tracked* new_t;
+ if (new_len <= ea->alloc_len &&
+ (4*new_len >= ea->alloc_len || ea->alloc_len == ea->min_alloc_len))
return 1;
- new_alloc_len = trackst.len * 2;
- if (new_alloc_len < MIN_TRACKST_ALLOC_LEN)
- new_alloc_len = MIN_TRACKST_ALLOC_LEN;
- new_entries = caml_stat_resize_noexc(trackst.entries,
- new_alloc_len * sizeof(struct tracked));
- if (new_entries == NULL) return 0;
- trackst.entries = new_entries;
- trackst.alloc_len = new_alloc_len;
+ new_alloc_len = new_len * 2;
+ if (new_alloc_len < ea->min_alloc_len)
+ new_alloc_len = ea->min_alloc_len;
+ new_t = caml_stat_resize_noexc(ea->t, new_alloc_len * sizeof(struct tracked));
+ if (new_t == NULL) return 0;
+ ea->t = new_t;
+ ea->alloc_len = new_alloc_len;
return 1;
}
+#define Invalid_index (~(uintnat)0)
+
Caml_inline uintnat new_tracked(uintnat n_samples, uintnat wosize,
- int is_unmarshalled, int is_young,
+ int source, int is_young,
value block, value user_data)
{
struct tracked *t;
- trackst.len++;
- if (!realloc_trackst()) {
- trackst.len--;
+ if (!realloc_entries(&local->entries, 1))
return Invalid_index;
- }
- t = &trackst.entries[trackst.len - 1];
+ local->entries.len++;
+ t = &local->entries.t[local->entries.len - 1];
t->block = block;
t->n_samples = n_samples;
t->wosize = wosize;
t->user_data = user_data;
- t->idx_ptr = NULL;
+ t->running = NULL;
t->alloc_young = is_young;
- t->unmarshalled = is_unmarshalled;
+ t->source = source;
t->promoted = 0;
t->deallocated = 0;
- t->cb_alloc_called = t->cb_promote_called = t->cb_dealloc_called = 0;
+ t->cb_promote_called = t->cb_dealloc_called = 0;
t->deleted = 0;
- t->callback_running = 0;
- return trackst.len - 1;
+ return local->entries.len - 1;
}
-static void mark_deleted(uintnat t_idx)
+static void mark_deleted(struct entry_array* ea, uintnat t_idx)
{
- struct tracked* t = &trackst.entries[t_idx];
+ struct tracked* t = &ea->t[t_idx];
t->deleted = 1;
t->user_data = Val_unit;
t->block = Val_unit;
- if (t_idx < trackst.delete) trackst.delete = t_idx;
- CAMLassert(t->idx_ptr == NULL);
+ if (t_idx < ea->delete_idx) ea->delete_idx = t_idx;
}
-/* The return value is an exception or [Val_unit] iff [*t_idx] is set to
- [Invalid_index]. In this case, the entry is deleted.
- Otherwise, the return value is a [Some(...)] block. */
-Caml_inline value run_callback_exn(uintnat *t_idx, value cb, value param) {
- struct tracked* t = &trackst.entries[*t_idx];
+Caml_inline value run_callback_exn(
+ struct entry_array* ea, uintnat t_idx, value cb, value param)
+{
+ struct tracked* t = &ea->t[t_idx];
value res;
- CAMLassert(!t->callback_running && t->idx_ptr == NULL);
+ CAMLassert(t->running == NULL);
CAMLassert(lambda > 0.);
- callback_running = t->callback_running = 1;
- t->idx_ptr = t_idx;
+ local->callback_status = ea == &entries_global ? t_idx : CB_LOCAL;
+ t->running = local;
+ t->user_data = Val_unit; /* Release root. */
res = caml_callback_exn(cb, param);
- callback_running = 0;
- /* The call above can modify [*t_idx] and thus invalidate [t]. */
- if (*t_idx == Invalid_index) {
- /* Make sure this entry has not been removed by [caml_memprof_set] */
- return Val_unit;
+ if (local->callback_status == CB_STOPPED) {
+ /* Make sure this entry has not been removed by [caml_memprof_stop] */
+ local->callback_status = CB_IDLE;
+ return Is_exception_result(res) ? res : Val_unit;
+ }
+ /* The call above can move the tracked entry and thus invalidate
+ [t_idx] and [t]. */
+ if (ea == &entries_global) {
+ CAMLassert(local->callback_status >= 0 && local->callback_status < ea->len);
+ t_idx = local->callback_status;
+ t = &ea->t[t_idx];
}
- t = &trackst.entries[*t_idx];
- t->idx_ptr = NULL;
- t->callback_running = 0;
+ local->callback_status = CB_IDLE;
+ CAMLassert(t->running == local);
+ t->running = NULL;
if (Is_exception_result(res) || res == Val_unit) {
/* Callback raised an exception or returned None or (), discard
this entry. */
- mark_deleted(*t_idx);
- *t_idx = Invalid_index;
- }
- return res;
-}
-
-/* Run all the needed callbacks for a given entry.
- In case of a thread context switch during a callback, this can be
- called in a reetrant way.
- If [*t_idx] equals [trackst.callback], then this function
- increments [trackst.callback].
- The index of the entry may change. It is set to [Invalid_index] if
- the entry is discarded.
- Returns:
- - An exception result if the callback raised an exception
- - Val_long(0) == Val_unit == None otherwise
- */
-static value handle_entry_callbacks_exn(uintnat* t_idx)
-{
- value sample_info, res, user_data; /* No need to make these roots */
- struct tracked* t = &trackst.entries[*t_idx];
- if (*t_idx == trackst.callback) trackst.callback++;
-
- if (t->deleted || t->callback_running) return Val_unit;
-
- if (!t->cb_alloc_called) {
- t->cb_alloc_called = 1;
- CAMLassert(Is_block(t->block)
- || Is_placeholder(t->block)
- || t->deallocated);
- sample_info = caml_alloc_small(4, 0);
- Field(sample_info, 0) = Val_long(t->n_samples);
- Field(sample_info, 1) = Val_long(t->wosize);
- Field(sample_info, 2) = Val_long(t->unmarshalled);
- Field(sample_info, 3) = t->user_data;
- t->user_data = Val_unit;
- res = run_callback_exn(t_idx,
- t->alloc_young ? Alloc_minor(tracker) : Alloc_major(tracker),
- sample_info);
- if (*t_idx == Invalid_index)
- return res;
- CAMLassert(!Is_exception_result(res) && Is_block(res) && Tag_val(res) == 0
- && Wosize_val(res) == 1);
- t = &trackst.entries[*t_idx];
- t->user_data = Field(res, 0);
- if (Is_block(t->user_data) && Is_young(t->user_data) &&
- *t_idx < trackst.young)
- trackst.young = *t_idx;
- }
-
- if (t->promoted && !t->cb_promote_called) {
- t->cb_promote_called = 1;
- user_data = t->user_data;
- t->user_data = Val_unit;
- res = run_callback_exn(t_idx, Promote(tracker), user_data);
- if (*t_idx == Invalid_index)
- return res;
+ mark_deleted(ea, t_idx);
+ return res;
+ } else {
+ /* Callback returned [Some _]. Store the value in [user_data]. */
CAMLassert(!Is_exception_result(res) && Is_block(res) && Tag_val(res) == 0
&& Wosize_val(res) == 1);
- t = &trackst.entries[*t_idx];
t->user_data = Field(res, 0);
if (Is_block(t->user_data) && Is_young(t->user_data) &&
- *t_idx < trackst.young)
- trackst.young = *t_idx;
- }
+ t_idx < ea->young_idx)
+ ea->young_idx = t_idx;
+
+ // If the following condition are met:
+ // - we are running a promotion callback,
+ // - the corresponding block is deallocated,
+ // - another thread is running callbacks in
+ // [caml_memprof_handle_postponed_exn],
+ // then [callback_idx] may have moved forward during this callback,
+ // which means that we may forget to run the deallocation callback.
+ // Hence, we reset [callback_idx] if appropriate.
+ if (ea == &entries_global && t->deallocated && !t->cb_dealloc_called &&
+ callback_idx > t_idx)
+ callback_idx = t_idx;
- if (t->deallocated && !t->cb_dealloc_called) {
- value cb = (t->promoted || !t->alloc_young) ?
- Dealloc_major(tracker) : Dealloc_minor(tracker);
- t->cb_dealloc_called = 1;
- user_data = t->user_data;
- t->user_data = Val_unit;
- res = run_callback_exn(t_idx, cb, user_data);
- /* [t] is invalid, but we do no longer use it. */
- CAMLassert(*t_idx == Invalid_index);
- CAMLassert(Is_exception_result(res) || res == Val_unit);
- return res;
+ return Val_unit;
}
+}
- return Val_unit;
+/* Run the allocation callback for a given entry of the local entries array.
+ This assumes that the corresponding [deleted] and
+ [running] fields of the entry are both set to 0.
+ Reentrancy is not a problem for this function, since other threads
+ will use a different array for entries.
+ The index of the entry will not change, except if [caml_memprof_stop] is
+ called .
+ Returns:
+ - An exception result if the callback raised an exception
+ - Val_long(0) == Val_unit == None otherwise
+ */
+static value run_alloc_callback_exn(uintnat t_idx)
+{
+ struct tracked* t = &local->entries.t[t_idx];
+ value sample_info;
+
+ CAMLassert(Is_block(t->block) || Is_placeholder(t->block) || t->deallocated);
+ sample_info = caml_alloc_small(4, 0);
+ Field(sample_info, 0) = Val_long(t->n_samples);
+ Field(sample_info, 1) = Val_long(t->wosize);
+ Field(sample_info, 2) = Val_long(t->source);
+ Field(sample_info, 3) = t->user_data;
+ return run_callback_exn(&local->entries, t_idx,
+ t->alloc_young ? Alloc_minor(tracker) : Alloc_major(tracker), sample_info);
}
-/* Remove any deleted entries, updating callback and young */
-static void flush_deleted(void)
+/* Remove any deleted entries from [ea], updating [ea->young_idx] and
+ [callback_idx] if [ea == &entries_global]. */
+static void flush_deleted(struct entry_array* ea)
{
- uintnat i = trackst.delete, j = i;
- while (i < trackst.len) {
- if (!trackst.entries[i].deleted) {
- if (trackst.entries[i].idx_ptr != NULL)
- *trackst.entries[i].idx_ptr = j;
- trackst.entries[j] = trackst.entries[i];
+ uintnat i, j;
+
+ if (ea == NULL) return;
+
+ j = i = ea->delete_idx;
+ while (i < ea->len) {
+ if (!ea->t[i].deleted) {
+ struct caml_memprof_th_ctx* runner = ea->t[i].running;
+ if (runner != NULL && runner->callback_status == i)
+ runner->callback_status = j;
+ ea->t[j] = ea->t[i];
j++;
}
i++;
- if (trackst.young == i) trackst.young = j;
- if (trackst.callback == i) trackst.callback = j;
+ if (ea->young_idx == i) ea->young_idx = j;
+ if (ea == &entries_global && callback_idx == i) callback_idx = j;
}
- trackst.delete = trackst.len = j;
- CAMLassert(trackst.callback <= trackst.len);
- CAMLassert(trackst.young <= trackst.len);
- realloc_trackst();
+ ea->delete_idx = ea->len = j;
+ CAMLassert(ea != &entries_global || callback_idx <= ea->len);
+ CAMLassert(ea->young_idx <= ea->len);
+ realloc_entries(ea, 0);
}
-static void check_action_pending(void) {
- if (!caml_memprof_suspended && trackst.callback < trackst.len)
+static void check_action_pending(void)
+{
+ if (local->suspended) return;
+ if (callback_idx < entries_global.len || local->entries.len > 0)
caml_set_action_pending();
}
+void caml_memprof_set_suspended(int s)
+{
+ local->suspended = s;
+ caml_memprof_renew_minor_sample();
+ if (!s) check_action_pending();
+}
+
/* In case of a thread context switch during a callback, this can be
called in a reetrant way. */
value caml_memprof_handle_postponed_exn(void)
{
value res = Val_unit;
- if (caml_memprof_suspended) return res;
- caml_memprof_suspended = 1;
- while (trackst.callback < trackst.len) {
- uintnat i = trackst.callback;
- res = handle_entry_callbacks_exn(&i);
- if (Is_exception_result(res)) break;
+ uintnat i;
+ if (local->suspended) return Val_unit;
+ if (callback_idx >= entries_global.len && local->entries.len == 0)
+ return Val_unit;
+
+ caml_memprof_set_suspended(1);
+
+ for (i = 0; i < local->entries.len; i++) {
+ /* We are the only thread allowed to modify [local->entries], so
+ the indices cannot shift, but it is still possible that
+ [caml_memprof_stop] got called during the callback,
+ invalidating all the entries. */
+ res = run_alloc_callback_exn(i);
+ if (Is_exception_result(res)) goto end;
+ if (local->entries.len == 0)
+ goto end; /* [caml_memprof_stop] has been called. */
+ if (local->entries.t[i].deleted) continue;
+ if (realloc_entries(&entries_global, 1))
+ /* Transfer the entry to the global array. */
+ entries_global.t[entries_global.len++] = local->entries.t[i];
+ mark_deleted(&local->entries, i);
+ }
+
+ while (callback_idx < entries_global.len) {
+ struct tracked* t = &entries_global.t[callback_idx];
+
+ if (t->deleted || t->running != NULL) {
+ /* This entry is not ready. Ignore it. */
+ callback_idx++;
+ } else if (t->promoted && !t->cb_promote_called) {
+ t->cb_promote_called = 1;
+ res = run_callback_exn(&entries_global, callback_idx, Promote(tracker),
+ t->user_data);
+ if (Is_exception_result(res)) goto end;
+ } else if (t->deallocated && !t->cb_dealloc_called) {
+ value cb = (t->promoted || !t->alloc_young) ?
+ Dealloc_major(tracker) : Dealloc_minor(tracker);
+ t->cb_dealloc_called = 1;
+ res = run_callback_exn(&entries_global, callback_idx, cb, t->user_data);
+ if (Is_exception_result(res)) goto end;
+ } else {
+ /* There is nothing more to do with this entry. */
+ callback_idx++;
+ }
}
- caml_memprof_suspended = 0;
- check_action_pending(); /* Needed in case of an exception */
- flush_deleted();
+
+ end:
+ flush_deleted(&local->entries);
+ flush_deleted(&entries_global);
+ /* We need to reset the suspended flag *after* flushing
+ [local->entries] to make sure the floag is not set back to 1. */
+ caml_memprof_set_suspended(0);
return res;
}
-void caml_memprof_oldify_young_roots(void)
+/**** Handling weak and strong roots when the GC runs. ****/
+
+typedef void (*ea_action)(struct entry_array*, void*);
+struct call_on_entry_array_data { ea_action f; void *data; };
+static void call_on_entry_array(struct caml_memprof_th_ctx* ctx, void *data)
+{
+ struct call_on_entry_array_data* closure = data;
+ closure->f(&ctx->entries, closure->data);
+}
+
+static void entry_arrays_iter(ea_action f, void *data)
+{
+ struct call_on_entry_array_data closure = { f, data };
+ f(&entries_global, data);
+ caml_memprof_th_ctx_iter_hook(call_on_entry_array, &closure);
+}
+
+static void entry_array_oldify_young_roots(struct entry_array *ea, void *data)
{
uintnat i;
- /* This loop should always have a small number of iteration (when
- compared to the size of the minor heap), because the young
+ (void)data;
+ /* This loop should always have a small number of iterations (when
+ compared to the size of the minor heap), because the young_idx
pointer should always be close to the end of the array. Indeed,
it is only moved back when returning from a callback triggered by
allocation or promotion, which can only happen for blocks
- allocated recently, which are close to the end of the trackst
- array. */
- for (i = trackst.young; i < trackst.len; i++)
- caml_oldify_one(trackst.entries[i].user_data,
- &trackst.entries[i].user_data);
+ allocated recently, which are close to the end of the
+ [entries_global] array. */
+ for (i = ea->young_idx; i < ea->len; i++)
+ caml_oldify_one(ea->t[i].user_data, &ea->t[i].user_data);
}
-void caml_memprof_minor_update(void)
+void caml_memprof_oldify_young_roots(void)
+{
+ entry_arrays_iter(entry_array_oldify_young_roots, NULL);
+}
+
+static void entry_array_minor_update(struct entry_array *ea, void *data)
{
uintnat i;
- /* See comment in [caml_memprof_oldify_young_roots] for the number
+ (void)data;
+ /* See comment in [entry_array_oldify_young_roots] for the number
of iterations of this loop. */
- for (i = trackst.young; i < trackst.len; i++) {
- struct tracked *t = &trackst.entries[i];
+ for (i = ea->young_idx; i < ea->len; i++) {
+ struct tracked *t = &ea->t[i];
CAMLassert(Is_block(t->block) || t->deleted || t->deallocated ||
Is_placeholder(t->block));
if (Is_block(t->block) && Is_young(t->block)) {
}
}
}
- if (trackst.callback > trackst.young) {
- trackst.callback = trackst.young;
+ ea->young_idx = ea->len;
+}
+
+void caml_memprof_minor_update(void)
+{
+ if (callback_idx > entries_global.young_idx) {
+ /* The entries after [entries_global.young_idx] will possibly get
+ promoted. Hence, there might be pending promotion callbacks. */
+ callback_idx = entries_global.young_idx;
check_action_pending();
}
- trackst.young = trackst.len;
+
+ entry_arrays_iter(entry_array_minor_update, NULL);
}
-void caml_memprof_do_roots(scanning_action f)
+static void entry_array_do_roots(struct entry_array *ea, void* data)
{
+ scanning_action f = data;
uintnat i;
- for (i = 0; i < trackst.len; i++)
- f(trackst.entries[i].user_data, &trackst.entries[i].user_data);
+ for (i = 0; i < ea->len; i++)
+ f(ea->t[i].user_data, &ea->t[i].user_data);
}
-void caml_memprof_update_clean_phase(void)
+void caml_memprof_do_roots(scanning_action f)
+{
+ entry_arrays_iter(entry_array_do_roots, f);
+}
+
+static void entry_array_clean_phase(struct entry_array *ea, void* data)
{
uintnat i;
- for (i = 0; i < trackst.len; i++) {
- struct tracked *t = &trackst.entries[i];
+ (void)data;
+ for (i = 0; i < ea->len; i++) {
+ struct tracked *t = &ea->t[i];
if (Is_block(t->block) && !Is_young(t->block)) {
CAMLassert(Is_in_heap(t->block));
CAMLassert(!t->alloc_young || t->promoted);
}
}
}
- trackst.callback = 0;
+}
+
+void caml_memprof_update_clean_phase(void)
+{
+ entry_arrays_iter(entry_array_clean_phase, NULL);
+ callback_idx = 0;
check_action_pending();
}
-void caml_memprof_invert_tracked(void)
+static void entry_array_invert(struct entry_array *ea, void *data)
{
uintnat i;
- for (i = 0; i < trackst.len; i++)
- caml_invert_root(trackst.entries[i].block, &trackst.entries[i].block);
+ (void)data;
+ for (i = 0; i < ea->len; i++)
+ caml_invert_root(ea->t[i].block, &ea->t[i].block);
}
-/**** Sampling procedures ****/
-
-void caml_memprof_track_alloc_shr(value block)
+void caml_memprof_invert_tracked(void)
{
- uintnat n_samples;
- value callstack = 0;
- CAMLassert(Is_in_heap(block));
+ entry_arrays_iter(entry_array_invert, NULL);
+}
- /* This test also makes sure memprof is initialized. */
- if (lambda == 0 || caml_memprof_suspended) return;
+/**** Sampling procedures ****/
- n_samples = mt_generate_binom(Whsize_val(block));
+static void maybe_track_block(value block, uintnat n_samples,
+ uintnat wosize, int src)
+{
+ value callstack;
if (n_samples == 0) return;
callstack = capture_callstack_postponed();
if (callstack == 0) return;
- new_tracked(n_samples, Wosize_val(block), 0, 0, block, callstack);
+ new_tracked(n_samples, wosize, src, Is_young(block), block, callstack);
check_action_pending();
}
+void caml_memprof_track_alloc_shr(value block)
+{
+ CAMLassert(Is_in_heap(block));
+ if (lambda == 0 || local->suspended) return;
+
+ maybe_track_block(block, rand_binom(Whsize_val(block)),
+ Wosize_val(block), SRC_NORMAL);
+}
+
+void caml_memprof_track_custom(value block, mlsize_t bytes)
+{
+ CAMLassert(Is_young(block) || Is_in_heap(block));
+ if (lambda == 0 || local->suspended) return;
+
+ maybe_track_block(block, rand_binom(Wsize_bsize(bytes)),
+ Wsize_bsize(bytes), SRC_CUSTOM);
+}
+
/* Shifts the next sample in the minor heap by [n] words. Essentially,
this tells the sampler to ignore the next [n] words of the minor
heap. */
geometric distribution. */
void caml_memprof_renew_minor_sample(void)
{
-
- if (lambda == 0) /* No trigger in the current minor heap. */
+ if (lambda == 0 || local->suspended)
+ /* No trigger in the current minor heap. */
caml_memprof_young_trigger = Caml_state->young_alloc_start;
else {
- uintnat geom = mt_generate_geom();
+ uintnat geom = rand_geom();
if (Caml_state->young_ptr - Caml_state->young_alloc_start < geom)
/* No trigger in the current minor heap. */
caml_memprof_young_trigger = Caml_state->young_alloc_start;
{
uintnat whsize = Whsize_wosize(wosize);
value callstack, res = Val_unit;
- int alloc_idx = 0, i, allocs_sampled = 0, has_delete = 0;
+ int alloc_idx = 0, i, allocs_sampled = 0;
intnat alloc_ofs, trigger_ofs;
- /* usually, only one allocation is sampled, even when the block contains
- multiple combined allocations. So, we delay allocating the full
- sampled_allocs array until we discover we actually need two entries */
- uintnat first_idx, *idx_tab = &first_idx;
double saved_lambda = lambda;
- if (caml_memprof_suspended) {
- caml_memprof_renew_minor_sample();
- return;
- }
-
- /* If [lambda == 0], then [caml_memprof_young_trigger] should be
+ /* If this condition is false, then [caml_memprof_young_trigger] should be
equal to [Caml_state->young_alloc_start]. But this function is only
called with [Caml_state->young_alloc_start <= Caml_state->young_ptr <
caml_memprof_young_trigger], which is contradictory. */
- CAMLassert(lambda > 0);
+ CAMLassert(!local->suspended && lambda > 0);
if (!from_caml) {
unsigned n_samples = 1 +
- mt_generate_binom(caml_memprof_young_trigger - 1 - Caml_state->young_ptr);
+ rand_binom(caml_memprof_young_trigger - 1 - Caml_state->young_ptr);
CAMLassert(encoded_alloc_lens == NULL); /* No Comballoc in C! */
caml_memprof_renew_minor_sample();
-
- callstack = capture_callstack_postponed();
- if (callstack == 0) return;
-
- new_tracked(n_samples, wosize,
- 0, 1, Val_hp(Caml_state->young_ptr), callstack);
- check_action_pending();
+ maybe_track_block(Val_hp(Caml_state->young_ptr), n_samples,
+ wosize, SRC_NORMAL);
return;
}
/* Restore the minor heap in a valid state for calling the callbacks.
We should not call the GC before these two instructions. */
Caml_state->young_ptr += whsize;
- caml_memprof_renew_minor_sample();
- caml_memprof_suspended = 1;
+ caml_memprof_set_suspended(1); // This also updates the memprof trigger
/* Perform the sampling of the block in the set of Comballoc'd
blocks, insert them in the entries array, and run the
alloc_ofs -= Whsize_wosize(alloc_wosz);
while (alloc_ofs < trigger_ofs) {
n_samples++;
- trigger_ofs -= mt_generate_geom();
+ trigger_ofs -= rand_geom();
}
if (n_samples > 0) {
- uintnat *idx_ptr, t_idx;
+ uintnat t_idx;
+ int stopped;
callstack = capture_callstack(alloc_idx);
- t_idx = new_tracked(n_samples, alloc_wosz,
- 0, 1, Placeholder_offs(alloc_ofs), callstack);
+ t_idx = new_tracked(n_samples, alloc_wosz, SRC_NORMAL, 1,
+ Placeholder_offs(alloc_ofs), callstack);
if (t_idx == Invalid_index) continue;
- res = handle_entry_callbacks_exn(&t_idx);
- if (t_idx == Invalid_index) {
- has_delete = 1;
+ res = run_alloc_callback_exn(t_idx);
+ /* Has [caml_memprof_stop] been called during the callback? */
+ stopped = local->entries.len == 0;
+ if (stopped) {
+ allocs_sampled = 0;
if (saved_lambda != lambda) {
/* [lambda] changed during the callback. We need to refresh
[trigger_ofs]. */
saved_lambda = lambda;
- trigger_ofs = lambda == 0. ? 0 : alloc_ofs - (mt_generate_geom() - 1);
+ trigger_ofs = lambda == 0. ? 0 : alloc_ofs - (rand_geom() - 1);
}
}
if (Is_exception_result(res)) break;
- if (t_idx == Invalid_index) continue;
-
- if (allocs_sampled == 1) {
- /* Found a second sampled allocation! Allocate a buffer for them */
- idx_tab = caml_stat_alloc_noexc(sizeof(uintnat) * nallocs);
- if (idx_tab == NULL) {
- alloc_ofs = 0;
- idx_tab = &first_idx;
- break;
- }
- idx_tab[0] = first_idx;
- if (idx_tab[0] != Invalid_index)
- trackst.entries[idx_tab[0]].idx_ptr = &idx_tab[0];
- }
-
- /* Usually, trackst.entries[...].idx_ptr is owned by the thread
- running a callback for the entry, if any. Here, we take ownership
- of idx_ptr until the end of the function.
-
- This does not conflict with the usual use of idx_ptr because no
- callbacks can run on this entry until the end of the function:
- the allocation callback has already run and the other callbacks
- do not run on Placeholder values */
- idx_ptr = &idx_tab[allocs_sampled];
- *idx_ptr = t_idx;
- trackst.entries[*idx_ptr].idx_ptr = idx_ptr;
- allocs_sampled++;
+ if (!stopped) allocs_sampled++;
}
}
CAMLassert(alloc_ofs == 0 || Is_exception_result(res));
CAMLassert(allocs_sampled <= nallocs);
- caml_memprof_suspended = 0;
- check_action_pending();
- /* We need to call [check_action_pending] since we
- reset [caml_memprof_suspended] to 0 (a GC collection may have
- triggered some new callback).
-
- We need to make sure that the action pending flag is not set
- systematically, which is to be expected, since [new_tracked]
- created a new block without updating
- [trackst.callback]. Fortunately, [handle_entry_callback_exn]
- increments [trackst.callback] if it is equal to [t_idx]. */
-
- /* This condition happens either in the case of an exception or if
- one of the callbacks returned [None]. If these cases happen
- frequently, then we need to call [flush_deleted] somewhere to
- prevent a leak. */
- if (has_delete)
- flush_deleted();
-
- if (Is_exception_result(res)) {
- for (i = 0; i < allocs_sampled; i++)
- if (idx_tab[i] != Invalid_index) {
- struct tracked* t = &trackst.entries[idx_tab[i]];
+
+ if (!Is_exception_result(res)) {
+ /* The callbacks did not raise. The allocation will take place.
+ We now restore the minor heap in the state needed by
+ [Alloc_small_aux]. */
+ if (Caml_state->young_ptr - whsize < Caml_state->young_trigger) {
+ CAML_EV_COUNTER(EV_C_FORCE_MINOR_MEMPROF, 1);
+ caml_gc_dispatch();
+ }
+
+ /* Re-allocate the blocks in the minor heap. We should not call the
+ GC after this. */
+ Caml_state->young_ptr -= whsize;
+
+ /* Make sure this block is not going to be sampled again. */
+ shift_sample(whsize);
+ }
+
+ /* Since [local->entries] is local to the current thread, we know for
+ sure that the allocated entries are the [alloc_sampled] last entries of
+ [local->entries]. */
+
+ for (i = 0; i < allocs_sampled; i++) {
+ uintnat idx = local->entries.len-allocs_sampled+i;
+ if (local->entries.t[idx].deleted) continue;
+ if (realloc_entries(&entries_global, 1)) {
+ /* Transfer the entry to the global array. */
+ struct tracked* t = &entries_global.t[entries_global.len];
+ entries_global.len++;
+ *t = local->entries.t[idx];
+
+ if (Is_exception_result(res)) {
/* The allocations are cancelled because of the exception,
but this callback has already been called. We simulate a
deallocation. */
t->block = Val_unit;
t->deallocated = 1;
- if (trackst.callback > idx_tab[i]) {
- trackst.callback = idx_tab[i];
- check_action_pending();
- }
+ } else {
+ /* If the execution of the callback has succeeded, then we start the
+ tracking of this block..
+
+ Subtlety: we are actually writing [t->block] with an invalid
+ (uninitialized) block. This is correct because the allocation
+ and initialization happens right after returning from
+ [caml_memprof_track_young]. */
+ t->block = Val_hp(Caml_state->young_ptr + Offs_placeholder(t->block));
+
+ /* We make sure that the action pending flag is not set
+ systematically, which is to be expected, since we created
+ a new block in the global entry array, but this new block
+ does not need promotion or deallocationc callback. */
+ if (callback_idx == entries_global.len - 1)
+ callback_idx = entries_global.len;
}
- if (idx_tab != &first_idx) caml_stat_free(idx_tab);
- caml_raise(Extract_exception(res));
- }
-
- /* We can now restore the minor heap in the state needed by
- [Alloc_small_aux]. */
- if (Caml_state->young_ptr - whsize < Caml_state->young_trigger) {
- CAML_EV_COUNTER(EV_C_FORCE_MINOR_MEMPROF, 1);
- caml_gc_dispatch();
+ }
+ mark_deleted(&local->entries, idx);
}
- /* Re-allocate the blocks in the minor heap. We should not call the
- GC after this. */
- Caml_state->young_ptr -= whsize;
+ flush_deleted(&local->entries);
+ /* We need to reset the suspended flag *after* flushing
+ [local->entries] to make sure the floag is not set back to 1. */
+ caml_memprof_set_suspended(0);
- /* Make sure this block is not going to be sampled again. */
- shift_sample(whsize);
-
- for (i = 0; i < allocs_sampled; i++) {
- if (idx_tab[i] != Invalid_index) {
- /* If the execution of the callback has succeeded, then we start the
- tracking of this block..
-
- Subtlety: we are actually writing [t->block] with an invalid
- (uninitialized) block. This is correct because the allocation
- and initialization happens right after returning from
- [caml_memprof_track_young]. */
- struct tracked *t = &trackst.entries[idx_tab[i]];
- t->block = Val_hp(Caml_state->young_ptr + Offs_placeholder(t->block));
- t->idx_ptr = NULL;
- CAMLassert(t->cb_alloc_called);
- if (idx_tab[i] < trackst.young) trackst.young = idx_tab[i];
- }
- }
- if (idx_tab != &first_idx) caml_stat_free(idx_tab);
+ if (Is_exception_result(res))
+ caml_raise(Extract_exception(res));
/* /!\ Since the heap is in an invalid state before initialization,
very little heap operations are allowed until then. */
return;
}
-void caml_memprof_track_interned(header_t* block, header_t* blockend) {
+void caml_memprof_track_interned(header_t* block, header_t* blockend)
+{
header_t *p;
value callstack = 0;
int is_young = Is_young(Val_hp(block));
- if (lambda == 0 || caml_memprof_suspended)
- return;
+ if (lambda == 0 || local->suspended) return;
p = block;
while (1) {
- uintnat next_sample = mt_generate_geom();
+ uintnat next_sample = rand_geom();
header_t *next_sample_p, *next_p;
if (next_sample > blockend - p)
break;
if (callstack == 0) callstack = capture_callstack_postponed();
if (callstack == 0) break; /* OOM */
- new_tracked(mt_generate_binom(next_p - next_sample_p) + 1,
- Wosize_hp(p), 1, is_young, Val_hp(p), callstack);
+ new_tracked(rand_binom(next_p - next_sample_p) + 1,
+ Wosize_hp(p), SRC_MARSHAL, is_young, Val_hp(p), callstack);
p = next_p;
}
check_action_pending();
/**** Interface with the OCaml code. ****/
-static void caml_memprof_init(void) {
- uintnat i;
-
+static void caml_memprof_init(void)
+{
init = 1;
-
- mt_index = MT_STATE_SIZE;
- mt_state[0] = 42;
- for (i = 1; i < MT_STATE_SIZE; i++)
- mt_state[i] = 0x6c078965 * (mt_state[i-1] ^ (mt_state[i-1] >> 30)) + i;
-}
-
-void caml_memprof_shutdown(void) {
- init = 0;
- started = 0;
- lambda = 0.;
- caml_memprof_suspended = 0;
- trackst.len = 0;
- trackst.callback = trackst.young = trackst.delete = 0;
- caml_stat_free(trackst.entries);
- trackst.entries = NULL;
- trackst.alloc_len = 0;
- caml_stat_free(callstack_buffer);
- callstack_buffer = NULL;
- callstack_buffer_len = 0;
+ xoshiro_init();
}
CAMLprim value caml_memprof_start(value lv, value szv, value tracker_param)
lambda = l;
if (l > 0) {
one_log1m_lambda = l == 1 ? 0 : 1/caml_log1p(-l);
- next_mt_generate_geom = mt_generate_geom();
+ rand_pos = RAND_BLOCK_SIZE;
+ /* next_rand_geom can be zero if the next word is to be sampled,
+ but rand_geom always returns a value >= 1. Subtract 1 to correct. */
+ next_rand_geom = rand_geom() - 1;
}
caml_memprof_renew_minor_sample();
CAMLreturn(Val_unit);
}
-CAMLprim value caml_memprof_stop(value unit)
+static void empty_entry_array(struct entry_array *ea) {
+ if (ea != NULL) {
+ ea->alloc_len = ea->len = ea->young_idx = ea->delete_idx = 0;
+ caml_stat_free(ea->t);
+ ea->t = NULL;
+ }
+}
+
+static void th_ctx_memprof_stop(struct caml_memprof_th_ctx* ctx, void* data)
{
- uintnat i;
+ (void)data;
+ if (ctx->callback_status != CB_IDLE) ctx->callback_status = CB_STOPPED;
+ empty_entry_array(&ctx->entries);
+}
+CAMLprim value caml_memprof_stop(value unit)
+{
if (!started) caml_failwith("Gc.Memprof.stop: not started.");
- /* This call to [caml_memprof_stop] will discard all the previously
- tracked blocks. We try one last time to call the postponed
- callbacks. */
- caml_raise_if_exception(caml_memprof_handle_postponed_exn());
-
- /* Discard the tracked blocks. */
- for (i = 0; i < trackst.len; i++)
- if (trackst.entries[i].idx_ptr != NULL)
- *trackst.entries[i].idx_ptr = Invalid_index;
- trackst.len = 0;
- trackst.callback = trackst.young = trackst.delete = 0;
- caml_stat_free(trackst.entries);
- trackst.entries = NULL;
- trackst.alloc_len = 0;
+ /* Discard the tracked blocks in the global entries array. */
+ empty_entry_array(&entries_global);
+
+ /* Discard the tracked blocks in the local entries array,
+ and set [callback_status] to [CB_STOPPED]. */
+ caml_memprof_th_ctx_iter_hook(th_ctx_memprof_stop, NULL);
+
+ callback_idx = 0;
lambda = 0;
+ // Reset the memprof trigger in order to make sure we won't enter
+ // [caml_memprof_track_young].
caml_memprof_renew_minor_sample();
started = 0;
/**** Interface with systhread. ****/
-void caml_memprof_init_th_ctx(struct caml_memprof_th_ctx* ctx) {
+static void th_ctx_iter_default(th_ctx_action f, void* data) {
+ f(local, data);
+}
+
+CAMLexport void (*caml_memprof_th_ctx_iter_hook)(th_ctx_action, void*)
+ = th_ctx_iter_default;
+
+CAMLexport struct caml_memprof_th_ctx* caml_memprof_new_th_ctx()
+{
+ struct caml_memprof_th_ctx* ctx =
+ caml_stat_alloc(sizeof(struct caml_memprof_th_ctx));
ctx->suspended = 0;
- ctx->callback_running = 0;
+ ctx->callback_status = CB_IDLE;
+ ctx->entries.t = NULL;
+ ctx->entries.min_alloc_len = MIN_ENTRIES_LOCAL_ALLOC_LEN;
+ ctx->entries.alloc_len = ctx->entries.len = 0;
+ ctx->entries.young_idx = ctx->entries.delete_idx = 0;
+ return ctx;
}
-void caml_memprof_stop_th_ctx(struct caml_memprof_th_ctx* ctx) {
- /* Make sure that no memprof callback is being executed in this
- thread. If so, memprof data structures may have pointers to the
- thread's stack. */
- if(ctx->callback_running)
- caml_fatal_error("Thread.exit called from a memprof callback.");
+CAMLexport void caml_memprof_delete_th_ctx(struct caml_memprof_th_ctx* ctx)
+{
+ if (ctx->callback_status >= 0)
+ /* A callback is running in this thread from the global entries
+ array. We delete the corresponding entry. */
+ mark_deleted(&entries_global, ctx->callback_status);
+ if (ctx == local) local = NULL;
+ caml_stat_free(ctx->entries.t);
+ if (ctx != &caml_memprof_main_ctx) caml_stat_free(ctx);
}
-void caml_memprof_save_th_ctx(struct caml_memprof_th_ctx* ctx) {
- ctx->suspended = caml_memprof_suspended;
- ctx->callback_running = callback_running;
+CAMLexport void caml_memprof_leave_thread(void)
+{
+ local = NULL;
}
-void caml_memprof_restore_th_ctx(const struct caml_memprof_th_ctx* ctx) {
- caml_memprof_suspended = ctx->suspended;
- callback_running = ctx->callback_running;
- check_action_pending();
+CAMLexport void caml_memprof_enter_thread(struct caml_memprof_th_ctx* ctx)
+{
+ CAMLassert(local == NULL);
+ local = ctx;
+ caml_memprof_set_suspended(ctx->suspended);
}
#ifdef THREADED_CODE
caml_thread_code((code_t) prog, len);
#endif
- caml_prepare_bytecode((code_t) prog, len);
/* Notify debugger after fragment gets added and reified. */
caml_debugger(CODE_LOADED, Val_long(fragnum));
- clos = caml_alloc_small (1, Closure_tag);
+ clos = caml_alloc_small (2, Closure_tag);
Code_val(clos) = (code_t) prog;
+ Closinfo_val(clos) = Make_closinfo(0, 2);
bytecode = caml_alloc_small (2, Abstract_tag);
Bytecode_val(bytecode)->prog = prog;
Bytecode_val(bytecode)->len = len;
}
/* signal to the interpreter machinery that a bytecode is no more
- needed (before freeing it) - this might be useful for a JIT
- implementation */
+ needed (before freeing it) */
CAMLprim value caml_static_release_bytecode(value bc)
{
code_t prog;
- asize_t len;
struct code_fragment *cf;
prog = Bytecode_val(bc)->prog;
- len = Bytecode_val(bc)->len;
caml_remove_debug_info(prog);
cf = caml_find_code_fragment_by_pc((char *) prog);
caml_remove_code_fragment(cf);
-#ifndef NATIVE_CODE
- caml_release_bytecode(prog, len);
-#else
- caml_failwith("Meta.static_release_bytecode impossible with native code");
-#endif
caml_stat_free(prog);
return Val_unit;
}
Caml_state->extern_sp -= 4;
nsp = Caml_state->extern_sp;
for (i = 0; i < 7; i++) nsp[i] = osp[i];
- nsp[7] = codeptr;
+ nsp[7] = (value) Nativeint_val(codeptr);
nsp[8] = env;
nsp[9] = Val_int(0);
nsp[10] = arg;
#include "caml/signals.h"
#include "caml/weak.h"
#include "caml/memprof.h"
-#ifdef WITH_SPACETIME
-#include "caml/spacetime.h"
-#endif
#include "caml/eventlog.h"
/* Pointers into the minor heap.
for (i = CAML_EPHE_FIRST_KEY; i < Wosize_val(re->ephe); i++){
child = Field (re->ephe, i);
if(child != caml_ephe_none
- && Is_block (child) && Is_young (child)
- && Hd_val (child) != 0){ /* Value not copied to major heap */
- return 0;
+ && Is_block (child) && Is_young (child)) {
+ if(Tag_val(child) == Infix_tag) child -= Infix_offset_val(child);
+ if(Hd_val (child) != 0) return 0; /* Value not copied to major heap */
}
}
return 1;
value v, new_v, f;
mlsize_t i;
struct caml_ephe_ref_elt *re;
- int redo = 0;
+ int redo;
+
+ again:
+ redo = 0;
while (oldify_todo_list != 0){
v = oldify_todo_list; /* Get the head. */
re < Caml_state->ephe_ref_table->ptr; re++){
/* look only at ephemeron with data in the minor heap */
if (re->offset == 1){
- value *data = &Field(re->ephe,1);
- if (*data != caml_ephe_none && Is_block (*data) && Is_young (*data)){
- if (Hd_val (*data) == 0){ /* Value copied to major heap */
- *data = Field (*data, 0);
+ value *data = &Field(re->ephe,1), v = *data;
+ if (v != caml_ephe_none && Is_block (v) && Is_young (v)){
+ mlsize_t offs = Tag_val(v) == Infix_tag ? Infix_offset_val(v) : 0;
+ v -= offs;
+ if (Hd_val (v) == 0){ /* Value copied to major heap */
+ *data = Field (v, 0) + offs;
} else {
if (ephe_check_alive_data(re)){
caml_oldify_one(*data,data);
}
}
- if (redo) caml_oldify_mopup ();
+ if (redo) goto again;
}
/* Make sure the minor heap is empty by performing a minor collection
re < Caml_state->ephe_ref_table->ptr; re++){
if(re->offset < Wosize_val(re->ephe)){
/* If it is not the case, the ephemeron has been truncated */
- value *key = &Field(re->ephe,re->offset);
- if (*key != caml_ephe_none && Is_block (*key) && Is_young (*key)){
- if (Hd_val (*key) == 0){ /* Value copied to major heap */
- *key = Field (*key, 0);
+ value *key = &Field(re->ephe,re->offset), v = *key;
+ if (v != caml_ephe_none && Is_block (v) && Is_young (v)){
+ mlsize_t offs = Tag_val (v) == Infix_tag ? Infix_offset_val (v) : 0;
+ v -= offs;
+ if (Hd_val (v) == 0){ /* Value copied to major heap */
+ *key = Field (v, 0) + offs;
}else{ /* Value not copied so it's dead */
CAMLassert(!ephe_check_alive_data(re));
*key = caml_ephe_none;
extern uintnat caml_instr_alloc_jump;
#endif /*CAML_INSTR*/
-/* Do a minor collection or a slice of major collection, call finalisation
- functions, etc.
+/* Do a minor collection or a slice of major collection, etc.
Leave enough room in the minor heap to allocate at least one object.
Guaranteed not to call any OCaml callback.
*/
-CAMLexport void caml_gc_dispatch (void)
+void caml_gc_dispatch (void)
{
- value *trigger = Caml_state->young_trigger; /* save old value of trigger */
-
CAML_EVENTLOG_DO({
CAML_EV_COUNTER(EV_C_ALLOC_JUMP, caml_instr_alloc_jump);
caml_instr_alloc_jump = 0;
});
- if (trigger == Caml_state->young_alloc_start
- || Caml_state->requested_minor_gc) {
+ if (Caml_state->young_trigger == Caml_state->young_alloc_start){
/* The minor heap is full, we must do a minor collection. */
+ Caml_state->requested_minor_gc = 1;
+ }else{
+ /* The minor heap is half-full, do a major GC slice. */
+ Caml_state->requested_major_slice = 1;
+ }
+ if (caml_gc_phase == Phase_idle){
+ /* The major GC needs an empty minor heap in order to start a new cycle.
+ If a major slice was requested, we need to do a minor collection
+ before we can do the major slice that starts a new major GC cycle.
+ If a minor collection was requested, we take the opportunity to start
+ a new major GC cycle.
+ In either case, we have to do a minor cycle followed by a major slice.
+ */
+ Caml_state->requested_minor_gc = 1;
+ Caml_state->requested_major_slice = 1;
+ }
+ if (Caml_state->requested_minor_gc) {
/* reset the pointers first because the end hooks might allocate */
CAML_EV_BEGIN(EV_MINOR);
Caml_state->requested_minor_gc = 0;
Caml_state->young_trigger = Caml_state->young_alloc_mid;
caml_update_young_limit();
caml_empty_minor_heap ();
- /* The minor heap is empty, we can start a major collection. */
CAML_EV_END(EV_MINOR);
- if (caml_gc_phase == Phase_idle)
- {
- CAML_EV_BEGIN(EV_MAJOR);
- caml_major_collection_slice (-1);
- CAML_EV_END(EV_MAJOR);
- }
}
- if (trigger != Caml_state->young_alloc_start
- || Caml_state->requested_major_slice) {
- /* The minor heap is half-full, do a major GC slice. */
+ if (Caml_state->requested_major_slice) {
Caml_state->requested_major_slice = 0;
Caml_state->young_trigger = Caml_state->young_alloc_start;
caml_update_young_limit();
callbacks. */
CAML_EV_COUNTER (EV_C_FORCE_MINOR_ALLOC_SMALL, 1);
caml_gc_dispatch ();
-#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
- if (caml_young_ptr == caml_young_alloc_end) {
- caml_spacetime_automatic_snapshot();
- }
-#endif
}
/* Re-do the allocation: we now have enough space in the minor heap. */
abort();
}
-/* If you change the caml_ext_table* functions, also update
- runtime/spacetime_nat.c:find_trie_node_from_libunwind. */
-
void caml_ext_table_init(struct ext_table * tbl, int init_capa)
{
tbl->size = 0;
#include "caml/mlvalues.h"
#include "caml/prims.h"
#include "caml/signals.h"
-#include "caml/spacetime.h"
-
-/* [size] is a value encoding a number of bytes */
-CAMLprim value caml_static_alloc(value size)
-{
- return (value) caml_stat_alloc((asize_t) Long_val(size));
-}
-
-CAMLprim value caml_static_free(value blk)
-{
- caml_stat_free((void *) blk);
- return Val_unit;
-}
-
-CAMLprim value caml_static_resize(value blk, value new_size)
-{
- return (value) caml_stat_resize((char *) blk, (asize_t) Long_val(new_size));
-}
-
-/* unused since GPR#427 */
-CAMLprim value caml_obj_is_block(value arg)
-{
- return Val_bool(Is_block(arg));
-}
CAMLprim value caml_obj_tag(value arg)
{
return Val_unit;
}
+CAMLprim value caml_obj_raw_field(value arg, value pos)
+{
+ /* Represent field contents as a native integer */
+ return caml_copy_nativeint((intnat) Field(arg, Long_val(pos)));
+}
+
+CAMLprim value caml_obj_set_raw_field(value arg, value pos, value bits)
+{
+ Field(arg, Long_val(pos)) = (value) Nativeint_val(bits);
+ return Val_unit;
+}
+
CAMLprim value caml_obj_make_forward (value blk, value fwd)
{
caml_modify(&Field(blk, 0), fwd);
CAMLprim value caml_obj_block(value tag, value size)
{
value res;
- mlsize_t sz, i;
+ mlsize_t sz;
tag_t tg;
sz = Long_val(size);
tg = Long_val(tag);
- if (sz == 0) return Atom(tg);
- res = caml_alloc(sz, tg);
- for (i = 0; i < sz; i++)
- Field(res, i) = Val_long(0);
+
+ /* When [tg < No_scan_tag], [caml_alloc] returns an object whose fields are
+ * initialised to [Val_unit]. Otherwise, the fields are uninitialised. We aim
+ * to avoid inconsistent states in other cases, on a best-effort basis --
+ * by default there is no initialization. */
+ switch (tg) {
+ default: {
+ res = caml_alloc(sz, tg);
+ break;
+ }
+ case Abstract_tag:
+ case Double_tag:
+ case Double_array_tag: {
+ /* In these cases, the initial content is irrelevant,
+ no specific initialization needed. */
+ res = caml_alloc(sz, tg);
+ break;
+ }
+ case Closure_tag: {
+ /* [Closure_tag] is below [no_scan_tag], but closures have more
+ structure with in particular a "closure information" that
+ indicates where the environment starts. We initialize this to
+ a sane value, as it may be accessed by runtime functions. */
+ /* Closinfo_val is the second field, so we need size at least 2 */
+ if (sz < 2) caml_invalid_argument ("Obj.new_block");
+ res = caml_alloc(sz, tg);
+ Closinfo_val(res) = Make_closinfo(0, 2); /* does not allocate */
+ break;
+ }
+ case String_tag: {
+ /* For [String_tag], the initial content does not matter. However,
+ the length of the string is encoded using the last byte of the
+ block. For this reason, the blocks with [String_tag] cannot be
+ of size [0]. We initialise the last byte to [0] such that the
+ length returned by [String.length] and [Bytes.length] is
+ a non-negative number. */
+ if (sz == 0) caml_invalid_argument ("Obj.new_block");
+ res = caml_alloc(sz, tg);
+ Field (res, sz - 1) = 0;
+ break;
+ }
+ case Custom_tag: {
+ /* It is difficult to correctly use custom objects allocated
+ through [Obj.new_block], so we disallow it completely. The
+ first field of a custom object must contain a valid pointer to
+ a block of custom operations. Without initialisation, hashing,
+ finalising or serialising this custom object will lead to
+ crashes. See #9513 for more details. */
+ caml_invalid_argument ("Obj.new_block");
+ }
+ }
return res;
}
-/* Spacetime profiling assumes that this function is only called from OCaml. */
CAMLprim value caml_obj_with_tag(value new_tag_v, value arg)
{
CAMLparam2 (new_tag_v, arg);
res = caml_alloc(sz, tg);
memcpy(Bp_val(res), Bp_val(arg), sz * sizeof(value));
} else if (sz <= Max_young_wosize) {
- uintnat profinfo;
- Get_my_profinfo_with_cached_backtrace(profinfo, sz);
- res = caml_alloc_small_with_my_or_given_profinfo(sz, tg, profinfo);
+ res = caml_alloc_small(sz, tg);
for (i = 0; i < sz; i++) Field(res, i) = Field(arg, i);
} else {
res = caml_alloc_shr(sz, tg);
+ /* It is safe to use [caml_initialize] even if [tag == Closure_tag]
+ and some of the "values" being copied are actually code pointers.
+ That's because the new "value" does not point to the minor heap. */
for (i = 0; i < sz; i++) caml_initialize(&Field(res, i), Field(arg, i));
- // Give gc a chance to run, and run memprof callbacks
+ /* Give gc a chance to run, and run memprof callbacks */
caml_process_pending_actions();
}
CAMLreturn (res);
}
-/* Spacetime profiling assumes that this function is only called from OCaml. */
CAMLprim value caml_obj_dup(value arg)
{
return caml_obj_with_tag(Val_long(Tag_val(arg)), arg);
return v + (unsigned long) Int32_val (offset);
}
-/* The following functions are used in stdlib/lazy.ml.
- They are not written in OCaml because they must be atomic with respect
+/* The following function is used in stdlib/lazy.ml.
+ It is not written in OCaml because it must be atomic with respect
to the GC.
*/
-CAMLprim value caml_lazy_follow_forward (value v)
-{
- if (Is_block (v) && Is_in_value_area(v)
- && Tag_val (v) == Forward_tag){
- return Forward_val (v);
- }else{
- return v;
- }
-}
-
CAMLprim value caml_lazy_make_forward (value v)
{
CAMLparam1 (v);
return (tag == Field(meths,li) ? Field (meths, li-1) : 0);
}
-/* these two functions might be useful to an hypothetical JIT */
-
-#ifdef CAML_JIT
-#ifdef NATIVE_CODE
-#define MARK 1
-#else
-#define MARK 0
-#endif
-value caml_cache_public_method (value meths, value tag, value *cache)
-{
- int li = 3, hi = Field(meths,0), mi;
- while (li < hi) {
- mi = ((li+hi) >> 1) | 1;
- if (tag < Field(meths,mi)) hi = mi-2;
- else li = mi;
- }
- *cache = (li-3)*sizeof(value) + MARK;
- return Field (meths, li-1);
-}
-
-value caml_cache_public_method2 (value *meths, value tag, value *cache)
-{
- value ofs = *cache & meths[1];
- if (*(value*)(((char*)(meths+3)) + ofs - MARK) == tag)
- return *(value*)(((char*)(meths+2)) + ofs - MARK);
- {
- int li = 3, hi = meths[0], mi;
- while (li < hi) {
- mi = ((li+hi) >> 1) | 1;
- if (tag < meths[mi]) hi = mi-2;
- else li = mi;
- }
- *cache = (li-3)*sizeof(value) + MARK;
- return meths[li-1];
- }
-}
-#endif /*CAML_JIT*/
-
static value oo_last_id = Val_int(0);
CAMLprim value caml_set_oo_id (value obj) {
struct queue_chunk *next;
value entries[ENTRIES_PER_QUEUE_CHUNK];
};
-
-
-CAMLprim value caml_obj_reachable_words(value v)
-{
- static struct queue_chunk first_chunk;
- struct queue_chunk *read_chunk, *write_chunk;
- int write_pos, read_pos, i;
-
- intnat size = 0;
- header_t hd;
- mlsize_t sz;
-
- if (Is_long(v) || !Is_in_heap_or_young(v)) return Val_int(0);
- if (Tag_hd(Hd_val(v)) == Infix_tag) v -= Infix_offset_hd(Hd_val(v));
- hd = Hd_val(v);
- sz = Wosize_hd(hd);
-
- read_chunk = write_chunk = &first_chunk;
- read_pos = 0;
- write_pos = 1;
- write_chunk->entries[0] = v | Colornum_hd(hd);
- Hd_val(v) = Bluehd_hd(hd);
-
- /* We maintain a queue of "interesting" blocks that have been seen.
- An interesting block is a block in the heap which does not
- represent an infix pointer. Infix pointers are normalized to the
- beginning of their block. Blocks in the static data area are excluded.
-
- The function maintains a queue of block pointers. Concretely,
- the queue is stored as a linked list of chunks, each chunk
- holding a number of pointers to interesting blocks. Initially,
- it contains only the "root" value. The first chunk of the queue
- is allocated statically. More chunks can be allocated as needed
- and released before this function exits.
-
- When a block is inserted in the queue, it is marked as blue.
- This mark is used to avoid a second visit of the same block.
- The real color is stored in the last 2 bits of the pointer in the
- queue. (Same technique as in extern.c.)
-
- Note: we make the assumption that there is no pointer
- from the static data area to the heap.
- */
-
- /* First pass: mark accessible blocks and compute their total size */
- while (read_pos != write_pos || read_chunk != write_chunk) {
- /* Pop the next element from the queue */
- if (read_pos == ENTRIES_PER_QUEUE_CHUNK) {
- read_pos = 0;
- read_chunk = read_chunk->next;
- }
- v = read_chunk->entries[read_pos++] & ~3;
-
- hd = Hd_val(v);
- sz = Wosize_hd(hd);
-
- size += Whsize_wosize(sz);
-
- if (Tag_hd(hd) < No_scan_tag) {
- /* Push the interesting fields on the queue */
- for (i = 0; i < sz; i++) {
- value v2 = Field(v, i);
- if (Is_block(v2) && Is_in_heap_or_young(v2)) {
- if (Tag_hd(Hd_val(v2)) == Infix_tag){
- v2 -= Infix_offset_hd(Hd_val(v2));
- }
- hd = Hd_val(v2);
- if (Color_hd(hd) != Caml_blue) {
- if (write_pos == ENTRIES_PER_QUEUE_CHUNK) {
- struct queue_chunk *new_chunk =
- malloc(sizeof(struct queue_chunk));
- if (new_chunk == NULL) {
- size = (-1);
- goto release;
- }
- write_chunk->next = new_chunk;
- write_pos = 0;
- write_chunk = new_chunk;
- }
- write_chunk->entries[write_pos++] = v2 | Colornum_hd(hd);
- Hd_val(v2) = Bluehd_hd(hd);
- }
- }
- }
- }
- }
-
- /* Second pass: restore colors and free extra queue chunks */
- release:
- read_pos = 0;
- read_chunk = &first_chunk;
- while (read_pos != write_pos || read_chunk != write_chunk) {
- color_t colornum;
- if (read_pos == ENTRIES_PER_QUEUE_CHUNK) {
- struct queue_chunk *prev = read_chunk;
- read_pos = 0;
- read_chunk = read_chunk->next;
- if (prev != &first_chunk) free(prev);
- }
- v = read_chunk->entries[read_pos++];
- colornum = v & 3;
- v &= ~3;
- Hd_val(v) = Coloredhd_hd(Hd_val(v), colornum);
- }
- if (read_chunk != &first_chunk) free(read_chunk);
-
- if (size < 0)
- caml_raise_out_of_memory();
- return Val_int(size);
-}
memprof's callback could raise an exception while
[handle_uncaught_exception] is running, so that the printing of
the exception fails. */
- caml_memprof_suspended = 1;
+ caml_memprof_set_suspended(1);
if (handle_uncaught_exception != NULL)
/* [Printexc.handle_uncaught_exception] does not raise exception. */
/* Record lowest stack address */
STORE sp, Caml_state(bottom_of_stack)
/* Set up stack space, saving return address */
- /* (1 reg for RA, 1 reg for FP, 21 allocatable int regs,
+ /* (1 reg for RA, 1 reg for FP, 22 allocatable int regs,
20 caller-save float regs) * 8 */
- /* + 1 for alignment */
addi sp, sp, -0x160
STORE ra, 0x8(sp)
STORE s0, 0x0(sp)
STORE t4, 0xa0(sp)
STORE t5, 0xa8(sp)
STORE t6, 0xb0(sp)
+ STORE t0, 0xb8(sp)
/* Save caller-save floating-point registers on the stack
(callee-saves are preserved by caml_garbage_collection) */
- fsd ft0, 0xb8(sp)
- fsd ft1, 0xc0(sp)
- fsd ft2, 0xc8(sp)
- fsd ft3, 0xd0(sp)
- fsd ft4, 0xd8(sp)
- fsd ft5, 0xe0(sp)
- fsd ft6, 0xe8(sp)
- fsd ft7, 0xf0(sp)
- fsd fa0, 0xf8(sp)
- fsd fa1, 0x100(sp)
- fsd fa2, 0x108(sp)
- fsd fa3, 0x110(sp)
- fsd fa4, 0x118(sp)
- fsd fa5, 0x120(sp)
- fsd fa6, 0x128(sp)
- fsd fa7, 0x130(sp)
- fsd ft8, 0x138(sp)
- fsd ft9, 0x140(sp)
+ fsd ft0, 0xc0(sp)
+ fsd ft1, 0xc8(sp)
+ fsd ft2, 0xd0(sp)
+ fsd ft3, 0xd8(sp)
+ fsd ft4, 0xe0(sp)
+ fsd ft5, 0xe8(sp)
+ fsd ft6, 0xf0(sp)
+ fsd ft7, 0xf8(sp)
+ fsd fa0, 0x100(sp)
+ fsd fa1, 0x108(sp)
+ fsd fa2, 0x110(sp)
+ fsd fa3, 0x118(sp)
+ fsd fa4, 0x120(sp)
+ fsd fa5, 0x128(sp)
+ fsd fa6, 0x130(sp)
+ fsd fa7, 0x138(sp)
+ fsd ft8, 0x140(sp)
fsd ft9, 0x148(sp)
fsd ft10, 0x150(sp)
fsd ft11, 0x158(sp)
LOAD t4, 0xa0(sp)
LOAD t5, 0xa8(sp)
LOAD t6, 0xb0(sp)
- fld ft0, 0xb8(sp)
- fld ft1, 0xc0(sp)
- fld ft2, 0xc8(sp)
- fld ft3, 0xd0(sp)
- fld ft4, 0xd8(sp)
- fld ft5, 0xe0(sp)
- fld ft6, 0xe8(sp)
- fld ft7, 0xf0(sp)
- fld fa0, 0xf8(sp)
- fld fa1, 0x100(sp)
- fld fa2, 0x108(sp)
- fld fa3, 0x110(sp)
- fld fa4, 0x118(sp)
- fld fa5, 0x120(sp)
- fld fa6, 0x128(sp)
- fld fa7, 0x130(sp)
- fld ft8, 0x138(sp)
- fld ft9, 0x140(sp)
+ LOAD t0, 0xb8(sp)
+ fld ft0, 0xc0(sp)
+ fld ft1, 0xc8(sp)
+ fld ft2, 0xd0(sp)
+ fld ft3, 0xd8(sp)
+ fld ft4, 0xe0(sp)
+ fld ft5, 0xe8(sp)
+ fld ft6, 0xf0(sp)
+ fld ft7, 0xf8(sp)
+ fld fa0, 0x100(sp)
+ fld fa1, 0x108(sp)
+ fld fa2, 0x110(sp)
+ fld fa3, 0x118(sp)
+ fld fa4, 0x120(sp)
+ fld fa5, 0x128(sp)
+ fld fa6, 0x130(sp)
+ fld fa7, 0x138(sp)
+ fld ft8, 0x140(sp)
fld ft9, 0x148(sp)
fld ft10, 0x150(sp)
fld ft11, 0x158(sp)
/* To walk the memory roots for garbage collection */
+#include "caml/codefrag.h"
#include "caml/finalise.h"
#include "caml/globroots.h"
#include "caml/major_gc.h"
intnat i, j;
/* The stack */
+ /* [caml_oldify_one] acts only on pointers into the minor heap.
+ So, it is safe to pass code pointers to [caml_oldify_one],
+ even in no-naked-pointers mode */
for (sp = Caml_state->extern_sp; sp < Caml_state->stack_high; sp++) {
caml_oldify_one (*sp, sp);
}
CAML_EV_END(EV_MAJOR_ROOTS_GLOBAL);
/* The stack and the local C roots */
CAML_EV_BEGIN(EV_MAJOR_ROOTS_LOCAL);
- caml_do_local_roots(f, Caml_state->extern_sp, Caml_state->stack_high,
- Caml_state->local_roots);
+ caml_do_local_roots_byt(f, Caml_state->extern_sp, Caml_state->stack_high,
+ Caml_state->local_roots);
CAML_EV_END(EV_MAJOR_ROOTS_LOCAL);
/* Global C roots */
CAML_EV_BEGIN(EV_MAJOR_ROOTS_C);
CAML_EV_END(EV_MAJOR_ROOTS_HOOK);
}
-CAMLexport void caml_do_local_roots (scanning_action f, value *stack_low,
- value *stack_high,
- struct caml__roots_block *local_roots)
+CAMLexport void caml_do_local_roots_byt (scanning_action f, value *stack_low,
+ value *stack_high,
+ struct caml__roots_block *local_roots)
{
register value * sp;
struct caml__roots_block *lr;
int i, j;
for (sp = stack_low; sp < stack_high; sp++) {
+#ifdef NO_NAKED_POINTERS
+ /* Code pointers inside the stack are naked pointers.
+ We must avoid passing them to function [f]. */
+ value v = *sp;
+ if (Is_block(v) && caml_find_code_fragment_by_pc((char *) v) == NULL) {
+ f(v, sp);
+ }
+#else
f (*sp, sp);
+#endif
}
for (lr = local_roots; lr != NULL; lr = lr->next) {
for (i = 0; i < lr->ntables; i++){
CAML_EV_END(EV_MAJOR_ROOTS_DYNAMIC_GLOBAL);
/* The stack and local roots */
CAML_EV_BEGIN(EV_MAJOR_ROOTS_LOCAL);
- caml_do_local_roots(f, Caml_state->bottom_of_stack,
- Caml_state->last_return_address, Caml_state->gc_regs,
- Caml_state->local_roots);
+ caml_do_local_roots_nat(f, Caml_state->bottom_of_stack,
+ Caml_state->last_return_address, Caml_state->gc_regs,
+ Caml_state->local_roots);
CAML_EV_END(EV_MAJOR_ROOTS_LOCAL);
/* Global C roots */
CAML_EV_BEGIN(EV_MAJOR_ROOTS_C);
CAML_EV_END(EV_MAJOR_ROOTS_HOOK);
}
-void caml_do_local_roots(scanning_action f, char * bottom_of_stack,
- uintnat last_retaddr, value * gc_regs,
- struct caml__roots_block * local_roots)
+void caml_do_local_roots_nat(scanning_action f, char * bottom_of_stack,
+ uintnat last_retaddr, value * gc_regs,
+ struct caml__roots_block * local_roots)
{
char * sp;
uintnat retaddr;
#include "caml/memprof.h"
#include "caml/finalise.h"
-#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
-#include "caml/spacetime.h"
-#endif
-
#ifndef NSIG
#define NSIG 64
#endif
= sigprocmask_wrapper;
#endif
+static int check_for_pending_signals(void)
+{
+ int i;
+ for (i = 0; i < NSIG; i++) {
+ if (caml_pending_signals[i]) return 1;
+ }
+ return 0;
+}
+
/* Execute all pending signals */
-value caml_process_pending_signals_exn(void)
+CAMLexport value caml_process_pending_signals_exn(void)
{
int i;
- int really_pending;
#ifdef POSIX_SIGNALS
sigset_t set;
#endif
/* Check that there is indeed a pending signal before issuing the
syscall in [caml_sigmask_hook]. */
- really_pending = 0;
- for (i = 0; i < NSIG; i++)
- if (caml_pending_signals[i]) {
- really_pending = 1;
- break;
- }
- if(!really_pending)
+ if (!check_for_pending_signals())
return Val_unit;
#ifdef POSIX_SIGNALS
caml_garbage_collection and caml_alloc_small_dispatch.
*/
-CAMLno_tsan void caml_record_signal(int signal_number)
+CAMLno_tsan
+CAMLexport void caml_record_signal(int signal_number)
{
caml_pending_signals[signal_number] = 1;
signals_are_pending = 1;
/* Management of blocking sections. */
-static intnat volatile caml_async_signal_mode = 0;
-
static void caml_enter_blocking_section_default(void)
{
- CAMLassert (caml_async_signal_mode == 0);
- caml_async_signal_mode = 1;
}
static void caml_leave_blocking_section_default(void)
{
- CAMLassert (caml_async_signal_mode == 1);
- caml_async_signal_mode = 0;
-}
-
-static int caml_try_leave_blocking_section_default(void)
-{
- intnat res;
- Read_and_clear(res, caml_async_signal_mode);
- return res;
}
CAMLexport void (*caml_enter_blocking_section_hook)(void) =
caml_enter_blocking_section_default;
CAMLexport void (*caml_leave_blocking_section_hook)(void) =
caml_leave_blocking_section_default;
-CAMLexport int (*caml_try_leave_blocking_section_hook)(void) =
- caml_try_leave_blocking_section_default;
CAMLno_tsan /* The read of [caml_something_to_do] is not synchronized. */
CAMLexport void caml_enter_blocking_section(void)
}
}
+CAMLexport void caml_enter_blocking_section_no_pending(void)
+{
+ caml_enter_blocking_section_hook ();
+}
+
CAMLexport void caml_leave_blocking_section(void)
{
int saved_errno;
examined by [caml_process_pending_signals_exn], then
[signals_are_pending] is 0 but the signal needs to be
handled at this point. */
- signals_are_pending = 1;
- caml_raise_if_exception(caml_process_pending_signals_exn());
+ if (check_for_pending_signals()) {
+ signals_are_pending = 1;
+ caml_set_action_pending();
+ }
errno = saved_errno;
}
{
value res;
value handler;
-#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
- void* saved_spacetime_trie_node_ptr;
-#endif
#ifdef POSIX_SIGNALS
sigset_t nsigs, sigs;
/* Block the signal before executing the handler, and record in sigs
sigaddset(&nsigs, signal_number);
caml_sigmask_hook(SIG_BLOCK, &nsigs, &sigs);
#endif
-#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
- /* We record the signal handler's execution separately, in the same
- trie used for finalisers. */
- saved_spacetime_trie_node_ptr
- = caml_spacetime_trie_node_ptr;
- caml_spacetime_trie_node_ptr
- = caml_spacetime_finaliser_trie_root;
-#endif
-#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
- /* Handled action may have no associated handler, which we interpret
- as meaning the signal should be handled by a call to exit. This is
- used to allow spacetime profiles to be completed on interrupt */
- if (caml_signal_handlers == 0) {
- res = caml_sys_exit(Val_int(2));
- } else {
- handler = Field(caml_signal_handlers, signal_number);
- if (!Is_block(handler)) {
- res = caml_sys_exit(Val_int(2));
- } else {
-#else
handler = Field(caml_signal_handlers, signal_number);
-#endif
res = caml_callback_exn(
handler,
Val_int(caml_rev_convert_signal_number(signal_number)));
-#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
- }
- }
- caml_spacetime_trie_node_ptr = saved_spacetime_trie_node_ptr;
-#endif
#ifdef POSIX_SIGNALS
if (! in_signal_handler) {
/* Restore the original signal mask */
return extra_root;
}
+CAMLno_tsan /* The access to [caml_something_to_do] is not synchronized. */
+int caml_check_pending_actions()
+{
+ return caml_something_to_do;
+}
+
+value caml_process_pending_actions_with_root_exn(value extra_root)
+{
+ return process_pending_actions_with_root_exn(extra_root);
+}
+
value caml_process_pending_actions_with_root(value extra_root)
{
value res = process_pending_actions_with_root_exn(extra_root);
res = Val_int(1);
break;
case 2: /* was Signal_handle */
- #if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
- /* Handled action may have no associated handler
- which we treat as Signal_default */
- if (caml_signal_handlers == 0) {
- res = Val_int(0);
- } else {
- if (!Is_block(Field(caml_signal_handlers, sig))) {
- res = Val_int(0);
- } else {
- res = caml_alloc_small (1, 0);
- Field(res, 0) = Field(caml_signal_handlers, sig);
- }
- }
- #else
res = caml_alloc_small (1, 0);
Field(res, 0) = Field(caml_signal_handlers, sig);
- #endif
break;
default: /* error in caml_set_signal_action */
caml_sys_error(NO_ARG);
signal(signal_number, handle_signal);
#endif
if (signal_number < 0 || signal_number >= NSIG) return;
- if (caml_try_leave_blocking_section_hook()) {
- caml_raise_if_exception(caml_execute_signal_exn(signal_number, 1));
- caml_enter_blocking_section_hook();
- }else{
- caml_record_signal(signal_number);
- }
+ caml_record_signal(signal_number);
errno = saved_errno;
}
return 0;
}
-void caml_setup_stack_overflow_detection(void) {}
+CAMLexport void caml_setup_stack_overflow_detection(void) {}
#if defined(TARGET_amd64) && defined (SYS_linux)
#define _GNU_SOURCE
#endif
+#if defined(TARGET_i386) && defined (SYS_linux_elf)
+#define _GNU_SOURCE
+#endif
#include <signal.h>
#include <errno.h>
#include <stdio.h>
+#include "caml/codefrag.h"
#include "caml/fail.h"
#include "caml/memory.h"
#include "caml/osdeps.h"
#include "caml/signals_machdep.h"
#include "signals_osdep.h"
#include "caml/stack.h"
-#include "caml/spacetime.h"
#include "caml/memprof.h"
#include "caml/finalise.h"
extern void caml_win32_overflow_detection();
#endif
-extern char * caml_code_area_start, * caml_code_area_end;
-extern char caml_system__code_begin, caml_system__code_end;
-
-/* Do not use the macro from address_class.h here. */
-#undef Is_in_code_area
-#define Is_in_code_area(pc) \
- ( ((char *)(pc) >= caml_code_area_start && \
- (char *)(pc) <= caml_code_area_end) \
-|| ((char *)(pc) >= &caml_system__code_begin && \
- (char *)(pc) <= &caml_system__code_end) \
-|| (Classify_addr(pc) & In_code_area) )
-
/* This routine is the common entry point for garbage collection
and signal handling. It can trigger a callback to OCaml code.
With system threads, this callback can cause a context switch.
signal(sig, handle_signal);
#endif
if (sig < 0 || sig >= NSIG) return;
- if (caml_try_leave_blocking_section_hook ()) {
- caml_raise_if_exception(caml_execute_signal_exn(sig, 1));
- caml_enter_blocking_section_hook();
- } else {
- caml_record_signal(sig);
+ caml_record_signal(sig);
/* Some ports cache [Caml_state->young_limit] in a register.
Use the signal context to modify that register too, but only if
we are inside OCaml code (not inside C code). */
#if defined(CONTEXT_PC) && defined(CONTEXT_YOUNG_LIMIT)
- if (Is_in_code_area(CONTEXT_PC))
- CONTEXT_YOUNG_LIMIT = (context_reg) Caml_state->young_limit;
+ if (caml_find_code_fragment_by_pc((char *) CONTEXT_PC) != NULL)
+ CONTEXT_YOUNG_LIMIT = (context_reg) Caml_state->young_limit;
#endif
- }
errno = saved_errno;
}
&& fault_addr < Caml_state->top_of_stack
&& (uintnat)fault_addr >= CONTEXT_SP - EXTRA_STACK
#ifdef CONTEXT_PC
- && Is_in_code_area(CONTEXT_PC)
+ && caml_find_code_fragment_by_pc((char *) CONTEXT_PC) != NULL
#endif
) {
#ifdef RETURN_AFTER_STACK_OVERFLOW
#endif
caml_raise_stack_overflow();
#endif
+#ifdef NAKED_POINTERS_CHECKER
+ } else if (Caml_state->checking_pointer_pc) {
+#ifdef CONTEXT_PC
+ CONTEXT_PC = (context_reg)Caml_state->checking_pointer_pc;
+#else
+#error "CONTEXT_PC must be defined if RETURN_AFTER_STACK_OVERFLOW is"
+#endif /* CONTEXT_PC */
+#endif /* NAKED_POINTERS_CHECKER */
} else {
/* Otherwise, deactivate our exception handler and return,
causing fatal signal to be generated at point of error. */
#endif
}
-void caml_setup_stack_overflow_detection(void)
+CAMLexport void caml_setup_stack_overflow_detection(void)
{
#ifdef HAS_STACK_OVERFLOW_DETECTION
stack_t stk;
#include <sys/ucontext.h>
#include <AvailabilityMacros.h>
- #if !defined(MAC_OS_X_VERSION_10_5) \
- || MAC_OS_X_VERSION_MIN_REQUIRED < MAC_OS_X_VERSION_10_5
+ #if (!defined(MAC_OS_X_VERSION_10_5) \
+ || MAC_OS_X_VERSION_MIN_REQUIRED < MAC_OS_X_VERSION_10_5) \
+ && !defined(__IPHONE_OS_VERSION_MIN_REQUIRED)
#define CONTEXT_REG(r) r
#else
#define CONTEXT_REG(r) __##r
#elif defined(TARGET_i386) && defined(SYS_linux_elf)
#define DECLARE_SIGNAL_HANDLER(name) \
- static void name(int sig, struct sigcontext context)
+ static void name(int sig, siginfo_t * info, ucontext_t * context)
#define SET_SIGACT(sigact,name) \
- sigact.sa_handler = (void (*)(int)) (name); \
- sigact.sa_flags = 0
+ sigact.sa_sigaction = (void (*)(int,siginfo_t *,void *)) (name); \
+ sigact.sa_flags = SA_SIGINFO
- #define CONTEXT_FAULTING_ADDRESS ((char *) context.cr2)
- #define CONTEXT_PC (context.eip)
- #define CONTEXT_SP (context.esp)
+ typedef greg_t context_reg;
+ #define CONTEXT_PC (context->uc_mcontext.gregs[REG_EIP])
+ #define CONTEXT_SP (context->uc_mcontext.gregs[REG_ESP])
+ #define CONTEXT_FAULTING_ADDRESS ((char *)context->uc_mcontext.cr2)
/****************** I386, BSD_ELF */
#include <sys/ucontext.h>
#include <AvailabilityMacros.h>
- #if !defined(MAC_OS_X_VERSION_10_5) \
- || MAC_OS_X_VERSION_MIN_REQUIRED < MAC_OS_X_VERSION_10_5
+ #if (!defined(MAC_OS_X_VERSION_10_5) \
+ || MAC_OS_X_VERSION_MIN_REQUIRED < MAC_OS_X_VERSION_10_5) \
+ && !defined(__IPHONE_OS_VERSION_MIN_REQUIRED)
#define CONTEXT_REG(r) r
#else
#define CONTEXT_REG(r) __##r
#define CONTEXT_SP (CONTEXT_STATE.CONTEXT_REG(r1))
#define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
-/****************** PowerPC, ELF (Linux) */
+/****************** PowerPC 32 bits, ELF (Linux) */
-#elif defined(TARGET_power) && defined(SYS_elf)
+#elif defined(TARGET_power) && defined(MODEL_ppc) && defined(SYS_elf)
#define DECLARE_SIGNAL_HANDLER(name) \
static void name(int sig, struct sigcontext * context)
#define CONTEXT_YOUNG_PTR (context->regs->gpr[31])
#define CONTEXT_SP (context->regs->gpr[1])
+/****************** PowerPC 64 bits, ELF (Linux) */
+
+#elif defined(TARGET_power) && defined(SYS_elf)
+
+ #define DECLARE_SIGNAL_HANDLER(name) \
+ static void name(int sig, siginfo_t * info, ucontext_t * context)
+
+ #define SET_SIGACT(sigact,name) \
+ sigact.sa_sigaction = (void (*)(int,siginfo_t *,void *)) (name); \
+ sigact.sa_flags = SA_SIGINFO
+
+ typedef unsigned long context_reg;
+ #define CONTEXT_PC (context->uc_mcontext.gp_regs[32])
+ #define CONTEXT_EXCEPTION_POINTER (context->uc_mcontext.gp_regs[29])
+ #define CONTEXT_YOUNG_LIMIT (context->uc_mcontext.gp_regs[30])
+ #define CONTEXT_YOUNG_PTR (context->uc_mcontext.gp_regs[31])
+ #define CONTEXT_SP (context->uc_mcontext.gp_regs[1])
+ #define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
+
/****************** PowerPC, NetBSD */
#elif defined(TARGET_power) && defined (SYS_netbsd)
#elif defined(TARGET_s390x) && defined(SYS_elf)
#define DECLARE_SIGNAL_HANDLER(name) \
- static void name(int sig, struct sigcontext * context)
+ static void name(int sig, siginfo_t * info, ucontext_t * context)
#define SET_SIGACT(sigact,name) \
- sigact.sa_handler = (void (*)(int)) (name); \
- sigact.sa_flags = 0
+ sigact.sa_sigaction = (void (*)(int,siginfo_t *,void *)) (name); \
+ sigact.sa_flags = SA_SIGINFO
typedef unsigned long context_reg;
- #define CONTEXT_PC (context->sregs->regs.psw.addr)
- #define CONTEXT_EXCEPTION_POINTER (context->sregs->regs.gprs[13])
- #define CONTEXT_YOUNG_LIMIT (context->sregs->regs.gprs[10])
- #define CONTEXT_YOUNG_PTR (context->sregs->regs.gprs[11])
- #define CONTEXT_SP (context->sregs->regs.gprs[15])
+ #define CONTEXT_PC (context->uc_mcontext.psw.addr)
+ #define CONTEXT_EXCEPTION_POINTER (context->uc_mcontext.gregs[13])
+ #define CONTEXT_YOUNG_LIMIT (context->uc_mcontext.gregs[10])
+ #define CONTEXT_YOUNG_PTR (context->uc_mcontext.gregs[11])
+ #define CONTEXT_SP (context->uc_mcontext.gregs[15])
+ #define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
/******************** Default */
+++ /dev/null
-/**************************************************************************/
-/* */
-/* OCaml */
-/* */
-/* Mark Shinwell and Leo White, Jane Street Europe */
-/* */
-/* Copyright 2013--2016, Jane Street Group, LLC */
-/* */
-/* All rights reserved. This file is distributed under the terms of */
-/* the GNU Lesser General Public License version 2.1, with the */
-/* special exception on linking described in the file LICENSE. */
-/* */
-/**************************************************************************/
-
-#include "caml/fail.h"
-#include "caml/mlvalues.h"
-
-int caml_ensure_spacetime_dot_o_is_included = 42;
-
-CAMLprim value caml_spacetime_only_works_for_native_code(value foo, ...)
-{
- caml_failwith("Spacetime profiling only works for native code");
-}
-
-uintnat caml_spacetime_my_profinfo (void)
-{
- return 0;
-}
-
-CAMLprim value caml_spacetime_enabled (value v_unit)
-{
- return Val_false; /* running in bytecode */
-}
-
-CAMLprim value caml_register_channel_for_spacetime (value v_channel)
-{
- return Val_unit;
-}
+++ /dev/null
-/**************************************************************************/
-/* */
-/* OCaml */
-/* */
-/* Mark Shinwell and Leo White, Jane Street Europe */
-/* */
-/* Copyright 2013--2016, Jane Street Group, LLC */
-/* */
-/* All rights reserved. This file is distributed under the terms of */
-/* the GNU Lesser General Public License version 2.1, with the */
-/* special exception on linking described in the file LICENSE. */
-/* */
-/**************************************************************************/
-
-#define CAML_INTERNALS
-
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <limits.h>
-#include <math.h>
-#include <sys/types.h>
-#include <sys/stat.h>
-#include <fcntl.h>
-#include <signal.h>
-#include "caml/config.h"
-#ifdef HAS_UNISTD
-#include <unistd.h>
-#endif
-#ifdef _WIN32
-#include <process.h> /* for _getpid */
-#include <direct.h> /* for _wgetcwd */
-#endif
-
-#include "caml/alloc.h"
-#include "caml/backtrace_prim.h"
-#include "caml/fail.h"
-#include "caml/gc.h"
-#include "caml/intext.h"
-#include "caml/major_gc.h"
-#include "caml/memory.h"
-#include "caml/minor_gc.h"
-#include "caml/misc.h"
-#include "caml/mlvalues.h"
-#include "caml/osdeps.h"
-#include "caml/roots.h"
-#include "caml/signals.h"
-#include "caml/stack.h"
-#include "caml/sys.h"
-#include "caml/spacetime.h"
-
-#ifdef WITH_SPACETIME
-
-/* We force "noinline" in certain places to be sure we know how many
- frames there will be on the stack. */
-#ifdef _MSC_VER
-#define NOINLINE __declspec(noinline)
-#else
-#define NOINLINE __attribute__((noinline))
-#endif
-
-#ifdef HAS_LIBUNWIND
-#define UNW_LOCAL_ONLY
-#include "libunwind.h"
-#endif
-
-static int automatic_snapshots = 0;
-static double snapshot_interval = 0.0;
-static double next_snapshot_time = 0.0;
-static struct channel *snapshot_channel;
-static int pid_when_snapshot_channel_opened;
-
-extern value caml_spacetime_debug(value);
-
-static char* start_of_free_node_block;
-static char* end_of_free_node_block;
-
-typedef struct per_thread {
- value* trie_node_root;
- value* finaliser_trie_node_root;
- struct per_thread* next;
-} per_thread;
-
-/* List of tries corresponding to threads that have been created. */
-/* CR-soon mshinwell: just include the main trie in this list. */
-static per_thread* per_threads = NULL;
-static int num_per_threads = 0;
-
-/* [caml_spacetime_shapes] is defined in the startup file. */
-extern uint64_t* caml_spacetime_shapes;
-
-uint64_t** caml_spacetime_static_shape_tables = NULL;
-shape_table* caml_spacetime_dynamic_shape_tables = NULL;
-
-static uintnat caml_spacetime_profinfo = (uintnat) 0;
-
-value caml_spacetime_trie_root = Val_unit;
-value* caml_spacetime_trie_node_ptr = &caml_spacetime_trie_root;
-
-static value caml_spacetime_finaliser_trie_root_main_thread = Val_unit;
-value* caml_spacetime_finaliser_trie_root
- = &caml_spacetime_finaliser_trie_root_main_thread;
-
-/* CR-someday mshinwell: think about thread safety of the manipulation of
- this list for multicore */
-allocation_point* caml_all_allocation_points = NULL;
-
-static const uintnat chunk_size = 1024 * 1024;
-
-#ifdef _WIN32
-#define strdup_os wcsdup
-#else
-#define strdup_os strdup
-#endif
-
-static void reinitialise_free_node_block(void)
-{
- size_t index;
-
- start_of_free_node_block = (char*) caml_stat_alloc_noexc(chunk_size);
- end_of_free_node_block = start_of_free_node_block + chunk_size;
-
- for (index = 0; index < chunk_size / sizeof(value); index++) {
- ((value*) start_of_free_node_block)[index] = Val_unit;
- }
-}
-
-#ifndef O_BINARY
-#define O_BINARY 0
-#endif
-
-enum {
- FEATURE_CALL_COUNTS = 1,
-} features;
-
-static uint16_t version_number = 0;
-static uint32_t magic_number_base = 0xace00ace;
-
-static void caml_spacetime_write_magic_number_internal(struct channel* chan)
-{
- value magic_number;
- uint16_t features = 0;
-
-#ifdef ENABLE_CALL_COUNTS
- features |= FEATURE_CALL_COUNTS;
-#endif
-
- magic_number =
- Val_long(((uint64_t) magic_number_base)
- | (((uint64_t) version_number) << 32)
- | (((uint64_t) features) << 48));
-
- Lock(chan);
- caml_output_val(chan, magic_number, Val_long(0));
- Unlock(chan);
-}
-
-CAMLprim value caml_spacetime_write_magic_number(value v_channel)
-{
- caml_spacetime_write_magic_number_internal(Channel(v_channel));
- return Val_unit;
-}
-
-static char_os* automatic_snapshot_dir;
-
-static void open_snapshot_channel(void)
-{
- int fd;
- char_os filename[8192];
- int pid;
- int filename_len = sizeof(filename)/sizeof(char_os);
-#ifdef _WIN32
- pid = _getpid();
-#else
- pid = getpid();
-#endif
- snprintf_os(filename, filename_len, T("%s/spacetime-%d"),
- automatic_snapshot_dir, pid);
- filename[filename_len-1] = '\0';
- fd = open_os(filename, O_WRONLY | O_CREAT | O_TRUNC | O_BINARY, 0666);
- if (fd == -1) {
- automatic_snapshots = 0;
- }
- else {
- snapshot_channel = caml_open_descriptor_out(fd);
- snapshot_channel->flags |= CHANNEL_FLAG_BLOCKING_WRITE;
- pid_when_snapshot_channel_opened = pid;
- caml_spacetime_write_magic_number_internal(snapshot_channel);
- }
-}
-
-static void maybe_reopen_snapshot_channel(void)
-{
- /* This function should be used before writing to the automatic snapshot
- channel. It detects whether we have forked since the channel was opened.
- If so, we close the old channel (ignoring any errors just in case the
- old fd has been closed, e.g. in a double-fork situation where the middle
- process has a loop to manually close all fds and no Spacetime snapshot
- was written during that time) and then open a new one. */
-
- int pid;
-#ifdef _WIN32
- pid = _getpid();
-#else
- pid = getpid();
-#endif
-
- if (pid != pid_when_snapshot_channel_opened) {
- caml_close_channel(snapshot_channel);
- open_snapshot_channel();
- }
-}
-
-extern void caml_spacetime_automatic_save(void);
-
-void caml_spacetime_initialize(void)
-{
- /* Note that this is called very early (even prior to GC initialisation). */
-
- char_os *ap_interval;
-
- reinitialise_free_node_block();
-
- caml_spacetime_static_shape_tables = &caml_spacetime_shapes;
-
- ap_interval = caml_secure_getenv (T("OCAML_SPACETIME_INTERVAL"));
- if (ap_interval != NULL) {
- unsigned int interval = 0;
- sscanf_os(ap_interval, T("%u"), &interval);
- if (interval != 0) {
- double time;
- char_os cwd[4096];
- char_os* user_specified_automatic_snapshot_dir;
- int dir_ok = 1;
-
- user_specified_automatic_snapshot_dir =
- caml_secure_getenv(T("OCAML_SPACETIME_SNAPSHOT_DIR"));
-
- if (user_specified_automatic_snapshot_dir == NULL) {
-#if defined(HAS_GETCWD)
- if (getcwd_os(cwd, sizeof(cwd)/sizeof(char_os)) == NULL) {
- dir_ok = 0;
- }
-#else
- dir_ok = 0;
-#endif
- if (dir_ok) {
- automatic_snapshot_dir = strdup_os(cwd);
- }
- }
- else {
- automatic_snapshot_dir =
- strdup_os(user_specified_automatic_snapshot_dir);
- }
-
- if (dir_ok) {
- automatic_snapshots = 1;
- open_snapshot_channel();
- if (automatic_snapshots) {
-#ifdef SIGINT
- /* Catch interrupt so that the profile can be completed.
- We do this by marking the signal as handled without
- specifying an actual handler. This causes the signal
- to be handled by a call to exit. */
- caml_set_signal_action(SIGINT, 2);
-#endif
- snapshot_interval = interval / 1e3;
- time = caml_sys_time_unboxed(Val_unit);
- next_snapshot_time = time + snapshot_interval;
- atexit(&caml_spacetime_automatic_save);
- }
- }
- }
- }
-}
-
-void caml_spacetime_register_shapes(void* dynlinked_table)
-{
- shape_table* table;
- table = (shape_table*) caml_stat_alloc_noexc(sizeof(shape_table));
- if (table == NULL) {
- fprintf(stderr, "Out of memory whilst registering shape table");
- abort();
- }
- table->table = (uint64_t*) dynlinked_table;
- table->next = caml_spacetime_dynamic_shape_tables;
- caml_spacetime_dynamic_shape_tables = table;
-}
-
-CAMLprim value caml_spacetime_trie_is_initialized (value v_unit)
-{
- return (caml_spacetime_trie_root == Val_unit) ? Val_false : Val_true;
-}
-
-CAMLprim value caml_spacetime_get_trie_root (value v_unit)
-{
- return caml_spacetime_trie_root;
-}
-
-void caml_spacetime_register_thread(
- value* trie_node_root, value* finaliser_trie_node_root)
-{
- per_thread* thr;
-
- thr = (per_thread*) caml_stat_alloc_noexc(sizeof(per_thread));
- if (thr == NULL) {
- fprintf(stderr, "Out of memory while registering thread for profiling\n");
- abort();
- }
- thr->next = per_threads;
- per_threads = thr;
-
- thr->trie_node_root = trie_node_root;
- thr->finaliser_trie_node_root = finaliser_trie_node_root;
-
- /* CR-soon mshinwell: record thread ID (and for the main thread too) */
-
- num_per_threads++;
-}
-
-static void caml_spacetime_save_event_internal (value v_time_opt,
- struct channel* chan,
- value v_event_name)
-{
- value v_time;
- double time_override = 0.0;
- int use_time_override = 0;
-
- if (Is_block(v_time_opt)) {
- time_override = Double_field(Field(v_time_opt, 0), 0);
- use_time_override = 1;
- }
- v_time = caml_spacetime_timestamp(time_override, use_time_override);
-
- Lock(chan);
- caml_output_val(chan, Val_long(2), Val_long(0));
- caml_output_val(chan, v_event_name, Val_long(0));
- caml_extern_allow_out_of_heap = 1;
- caml_output_val(chan, v_time, Val_long(0));
- caml_extern_allow_out_of_heap = 0;
- Unlock(chan);
-
- caml_stat_free(Hp_val(v_time));
-}
-
-CAMLprim value caml_spacetime_save_event (value v_time_opt,
- value v_channel,
- value v_event_name)
-{
- struct channel* chan = Channel(v_channel);
-
- caml_spacetime_save_event_internal(v_time_opt, chan, v_event_name);
-
- return Val_unit;
-}
-
-
-void save_trie (struct channel *chan, double time_override,
- int use_time_override)
-{
- value v_time, v_frames, v_shapes;
- /* CR-someday mshinwell: The commented-out changes here are for multicore,
- where we think we should have one trie per domain. */
- /* int num_marshalled = 0;
- per_thread* thr = per_threads; */
-
- Lock(chan);
-
- caml_output_val(chan, Val_long(1), Val_long(0));
-
- v_time = caml_spacetime_timestamp(time_override, use_time_override);
- v_frames = caml_spacetime_frame_table();
- v_shapes = caml_spacetime_shape_table();
-
- caml_extern_allow_out_of_heap = 1;
- caml_output_val(chan, v_time, Val_long(0));
- caml_output_val(chan, v_frames, Val_long(0));
- caml_output_val(chan, v_shapes, Val_long(0));
- caml_extern_allow_out_of_heap = 0;
-
- caml_output_val(chan, Val_long(1) /* Val_long(num_per_threads + 1) */,
- Val_long(0));
-
- /* Marshal both the main and finaliser tries, for all threads that have
- been created, to an [out_channel]. This can be done by using the
- extern.c code as usual, since the trie looks like standard OCaml values;
- but we must allow it to traverse outside the heap. */
-
- caml_extern_allow_out_of_heap = 1;
- caml_output_val(chan, caml_spacetime_trie_root, Val_long(0));
- caml_output_val(chan,
- caml_spacetime_finaliser_trie_root_main_thread, Val_long(0));
- /* while (thr != NULL) {
- caml_output_val(chan, *(thr->trie_node_root), Val_long(0));
- caml_output_val(chan, *(thr->finaliser_trie_node_root),
- Val_long(0));
- thr = thr->next;
- num_marshalled++;
- }
- CAMLassert(num_marshalled == num_per_threads); */
- caml_extern_allow_out_of_heap = 0;
-
- Unlock(chan);
-}
-
-CAMLprim value caml_spacetime_save_trie (value v_time_opt, value v_channel)
-{
- struct channel* channel = Channel(v_channel);
- double time_override = 0.0;
- int use_time_override = 0;
-
- if (Is_block(v_time_opt)) {
- time_override = Double_field(Field(v_time_opt, 0), 0);
- use_time_override = 1;
- }
-
- save_trie(channel, time_override, use_time_override);
-
- return Val_unit;
-}
-
-c_node_type caml_spacetime_classify_c_node(c_node* node)
-{
- return (node->pc & 2) ? CALL : ALLOCATION;
-}
-
-c_node* caml_spacetime_c_node_of_stored_pointer(value node_stored)
-{
- CAMLassert(node_stored == Val_unit || Is_c_node(node_stored));
- return (node_stored == Val_unit) ? NULL : (c_node*) Hp_val(node_stored);
-}
-
-c_node* caml_spacetime_c_node_of_stored_pointer_not_null(
- value node_stored)
-{
- CAMLassert(Is_c_node(node_stored));
- return (c_node*) Hp_val(node_stored);
-}
-
-value caml_spacetime_stored_pointer_of_c_node(c_node* c_node)
-{
- value node;
- CAMLassert(c_node != NULL);
- node = Val_hp(c_node);
- CAMLassert(Is_c_node(node));
- return node;
-}
-
-#ifdef HAS_LIBUNWIND
-static int pc_inside_c_node_matches(c_node* node, void* pc)
-{
- return Decode_c_node_pc(node->pc) == pc;
-}
-#endif
-
-static value allocate_uninitialized_ocaml_node(int size_including_header)
-{
- void* node;
- uintnat size;
-
- CAMLassert(size_including_header >= 3);
- node = caml_stat_alloc(sizeof(uintnat) * size_including_header);
-
- size = size_including_header * sizeof(value);
-
- node = (void*) start_of_free_node_block;
- if (end_of_free_node_block - start_of_free_node_block < size) {
- reinitialise_free_node_block();
- node = (void*) start_of_free_node_block;
- CAMLassert(end_of_free_node_block - start_of_free_node_block >= size);
- }
-
- start_of_free_node_block += size;
-
- /* We don't currently rely on [uintnat] alignment, but we do need some
- alignment, so just be sure. */
- CAMLassert (((uintnat) node) % sizeof(uintnat) == 0);
- return Val_hp(node);
-}
-
-static value find_tail_node(value node, void* callee)
-{
- /* Search the tail chain within [node] (which corresponds to an invocation
- of a caller of [callee]) to determine whether it contains a tail node
- corresponding to [callee]. Returns any such node, or [Val_unit] if no
- such node exists. */
-
- value starting_node;
- value pc;
- value found = Val_unit;
-
- starting_node = node;
- pc = Encode_node_pc(callee);
-
- do {
- CAMLassert(Is_ocaml_node(node));
- if (Node_pc(node) == pc) {
- found = node;
- }
- else {
- node = Tail_link(node);
- }
- } while (found == Val_unit && starting_node != node);
-
- return found;
-}
-
-CAMLprim value caml_spacetime_allocate_node(
- int size_including_header, void* pc, value* node_hole)
-{
- value node;
- value caller_node = Val_unit;
-
- node = *node_hole;
- /* The node hole should either contain [Val_unit], indicating that this
- function was not tail called and we have not been to this point in the
- trie before; or it should contain a value encoded using
- [Encoded_tail_caller_node] that points at the node of a caller
- that tail called the current function. (Such a value is necessary to
- be able to find the start of the caller's node, and hence its tail
- chain, so we as a tail-called callee can link ourselves in.) */
- CAMLassert(Is_tail_caller_node_encoded(node));
-
- if (node != Val_unit) {
- value tail_node;
- /* The callee was tail called. Find whether there already exists a node
- for it in the tail call chain within the caller's node. The caller's
- node must always be an OCaml node. */
- caller_node = Decode_tail_caller_node(node);
- tail_node = find_tail_node(caller_node, pc);
- if (tail_node != Val_unit) {
- /* This tail calling sequence has happened before; just fill the hole
- with the existing node and return. */
- *node_hole = tail_node;
- return 0; /* indicates an existing node was returned */
- }
- }
-
- node = allocate_uninitialized_ocaml_node(size_including_header);
- Hd_val(node) =
- Make_header(size_including_header - 1, OCaml_node_tag, Caml_black);
- CAMLassert((((uintnat) pc) % 1) == 0);
- Node_pc(node) = Encode_node_pc(pc);
- /* If the callee was tail called, then the tail link field will link this
- new node into an existing tail chain. Otherwise, it is initialized with
- the empty tail chain, i.e. the one pointing directly at [node]. */
- if (caller_node == Val_unit) {
- Tail_link(node) = node;
- }
- else {
- Tail_link(node) = Tail_link(caller_node);
- Tail_link(caller_node) = node;
- }
-
- /* The callee node pointers for direct tail call points are
- initialized from code emitted by the OCaml compiler. This is done to
- avoid having to pass this function a description of which nodes are
- direct tail call points. (We cannot just count them and put them at the
- beginning of the node because we need the indexes of elements within the
- node during instruction selection before we have found all call points.)
-
- All other fields have already been initialised by
- [reinitialise_free_node_block].
- */
-
- *node_hole = node;
-
- return 1; /* indicates a new node was created */
-}
-
-static c_node* allocate_c_node(void)
-{
- c_node* node;
- size_t index;
-
- node = (c_node*) start_of_free_node_block;
- if (end_of_free_node_block - start_of_free_node_block < sizeof(c_node)) {
- reinitialise_free_node_block();
- node = (c_node*) start_of_free_node_block;
- CAMLassert(end_of_free_node_block - start_of_free_node_block
- >= sizeof(c_node));
- }
- start_of_free_node_block += sizeof(c_node);
-
- CAMLassert((sizeof(c_node) % sizeof(uintnat)) == 0);
-
- /* CR-soon mshinwell: remove this and pad the structure properly */
- for (index = 0; index < sizeof(c_node) / sizeof(value); index++) {
- ((value*) node)[index] = Val_unit;
- }
-
- node->gc_header =
- Make_header(sizeof(c_node)/sizeof(uintnat) - 1, C_node_tag, Caml_black);
- node->data.call.callee_node = Val_unit;
- node->data.call.call_count = Val_long(0);
- node->next = Val_unit;
-
- return node;
-}
-
-/* Since a given indirect call site either always yields tail calls or
- always yields non-tail calls, the output of
- [caml_spacetime_indirect_node_hole_ptr] is uniquely determined by its
- first two arguments (the callee and the node hole). We cache these
- to increase performance of recursive functions containing an indirect
- call (e.g. [List.map] when not inlined). */
-static void* last_indirect_node_hole_ptr_callee;
-static value* last_indirect_node_hole_ptr_node_hole;
-static call_point* last_indirect_node_hole_ptr_result;
-
-CAMLprim value* caml_spacetime_indirect_node_hole_ptr
- (void* callee, value* node_hole, value caller_node)
-{
- /* Find the address of the node hole for an indirect call to [callee].
- If [caller_node] is not [Val_unit], it is a pointer to the caller's
- node, and indicates that this is a tail call site. */
-
- c_node* c_node;
- value encoded_callee;
-
- if (callee == last_indirect_node_hole_ptr_callee
- && node_hole == last_indirect_node_hole_ptr_node_hole) {
-#ifdef ENABLE_CALL_COUNTS
- last_indirect_node_hole_ptr_result->call_count =
- Val_long (Long_val (last_indirect_node_hole_ptr_result->call_count) + 1);
-#endif
- return &(last_indirect_node_hole_ptr_result->callee_node);
- }
-
- last_indirect_node_hole_ptr_callee = callee;
- last_indirect_node_hole_ptr_node_hole = node_hole;
-
- encoded_callee = Encode_c_node_pc_for_call(callee);
-
- while (*node_hole != Val_unit) {
- CAMLassert(((uintnat) *node_hole) % sizeof(value) == 0);
-
- c_node = caml_spacetime_c_node_of_stored_pointer_not_null(*node_hole);
-
- CAMLassert(c_node != NULL);
- CAMLassert(caml_spacetime_classify_c_node(c_node) == CALL);
-
- if (c_node->pc == encoded_callee) {
-#ifdef ENABLE_CALL_COUNTS
- c_node->data.call.call_count =
- Val_long (Long_val(c_node->data.call.call_count) + 1);
-#endif
- last_indirect_node_hole_ptr_result = &(c_node->data.call);
- return &(last_indirect_node_hole_ptr_result->callee_node);
- }
- else {
- node_hole = &c_node->next;
- }
- }
-
- c_node = allocate_c_node();
- c_node->pc = encoded_callee;
-
- if (caller_node != Val_unit) {
- /* This is a tail call site.
- Perform the initialization equivalent to that emitted by
- [Spacetime.code_for_function_prologue] for direct tail call
- sites. */
- c_node->data.call.callee_node = Encode_tail_caller_node(caller_node);
- }
-
- *node_hole = caml_spacetime_stored_pointer_of_c_node(c_node);
-
- CAMLassert(((uintnat) *node_hole) % sizeof(value) == 0);
- CAMLassert(*node_hole != Val_unit);
-
-#ifdef ENABLE_CALL_COUNTS
- c_node->data.call.call_count =
- Val_long (Long_val(c_node->data.call.call_count) + 1);
-#endif
- last_indirect_node_hole_ptr_result = &(c_node->data.call);
-
- return &(last_indirect_node_hole_ptr_result->callee_node);
-}
-
-/* Some notes on why caml_call_gc doesn't need a distinguished node.
- (Remember that thread switches are irrelevant here because each thread
- has its own trie.)
-
- caml_call_gc only invokes OCaml functions in the following circumstances:
- 1. running an OCaml finaliser;
- 2. executing an OCaml signal handler;
- 3. executing memprof callbacks.
- All of these are done on the finaliser trie. Furthermore, all of
- these invocations start via caml_callback; the code in this file for
- handling that (caml_spacetime_c_to_ocaml) correctly copes with that by
- attaching a single "caml_start_program" node that can cope with any
- number of indirect OCaml calls from that point.
-
- caml_call_gc may also invoke C functions that cause allocation. All of
- these (assuming libunwind support is present) will cause a chain of
- c_node structures to be attached to the trie, starting at the node hole
- passed to caml_call_gc from OCaml code. These structures are extensible
- and can thus accommodate any number of C backtraces leading from
- caml_call_gc.
-*/
-/* CR-soon mshinwell: it might in fact be the case now that nothing called
- from caml_call_gc will do any allocation that ends up on the trie. We
- can revisit this after the first release. */
-
-static NOINLINE void* find_trie_node_from_libunwind(int for_allocation,
- uintnat wosize, struct ext_table** cached_frames)
-{
-#ifdef HAS_LIBUNWIND
- /* Given that [Caml_state->last_return_address] is the most recent call site
- in OCaml code, and that we are now in C (or other) code called from that
- site, obtain a backtrace using libunwind and graft the most recent
- portion (everything back to but not including [last_return_address])
- onto the trie. See the important comment below regarding the fact that
- call site, and not callee, addresses are recorded during this process.
-
- If [for_allocation] is non-zero, the final node recorded will be for
- an allocation, and the returned pointer is to the allocation node.
- Otherwise, no node is recorded for the innermost frame, and the
- returned pointer is a pointer to the *node hole* where a node for that
- frame should be attached.
-
- If [for_allocation] is non-zero then [wosize] must give the size in
- words, excluding the header, of the value being allocated.
-
- If [cached_frames != NULL] then:
- 1. If [*cached_frames] is NULL then save the captured backtrace in a
- newly-allocated table and store the pointer to that table in
- [*cached_frames];
- 2. Otherwise use [*cached_frames] as the unwinding information.
- The intention is that when the context is known (e.g. a function such
- as [caml_make_vect] known to have been directly invoked from OCaml),
- we can avoid expensive calls to libunwind.
- */
-
- unw_cursor_t cur;
- unw_context_t ctx;
- int ret;
- int innermost_frame;
- int frame;
- static struct ext_table frames_local;
- struct ext_table* frames;
- static int ext_table_initialised = 0;
- int have_frames_already = 0;
- value* node_hole;
- c_node* node = NULL;
- int initial_table_size = 1000;
- int must_initialise_node_for_allocation = 0;
-
- if (!cached_frames) {
- if (!ext_table_initialised) {
- caml_ext_table_init(&frames_local, initial_table_size);
- ext_table_initialised = 1;
- }
- else {
- caml_ext_table_clear(&frames_local, 0);
- }
- frames = &frames_local;
- } else {
- if (*cached_frames) {
- frames = *cached_frames;
- have_frames_already = 1;
- }
- else {
- frames =
- (struct ext_table*) caml_stat_alloc_noexc(sizeof(struct ext_table));
- if (!frames) {
- caml_fatal_error("not enough memory for ext_table allocation");
- }
- caml_ext_table_init(frames, initial_table_size);
- *cached_frames = frames;
- }
- }
-
- if (!have_frames_already) {
- /* Get the stack backtrace as far as [Caml_state->last_return_address]. */
-
- ret = unw_getcontext(&ctx);
- if (ret != UNW_ESUCCESS) {
- return NULL;
- }
-
- ret = unw_init_local(&cur, &ctx);
- if (ret != UNW_ESUCCESS) {
- return NULL;
- }
-
- while ((ret = unw_step(&cur)) > 0) {
- unw_word_t ip;
- unw_get_reg(&cur, UNW_REG_IP, &ip);
- if (Caml_state->last_return_address == (uintnat) ip) {
- break;
- }
- else {
- /* Inlined some of [caml_ext_table_add] for speed. */
- if (frames->size < frames->capacity) {
- frames->contents[frames->size++] = (void*) ip;
- } else {
- caml_ext_table_add(frames, (void*) ip);
- }
- }
- }
- }
-
- /* We always need to ignore the frames for:
- #0 find_trie_node_from_libunwind
- #1 caml_spacetime_c_to_ocaml
- Further, if this is not an allocation point, we should not create the
- node for the current C function that triggered us (i.e. frame #2). */
- innermost_frame = for_allocation ? 1 : 2;
-
- if (frames->size - 1 < innermost_frame) {
- /* Insufficiently many frames (maybe no frames) returned from
- libunwind; just don't do anything. */
- return NULL;
- }
-
- node_hole = caml_spacetime_trie_node_ptr;
- /* Note that if [node_hole] is filled, then it must point to a C node,
- since it is not possible for there to be a call point in an OCaml
- function that sometimes calls C and sometimes calls OCaml. */
-
- for (frame = frames->size - 1; frame >= innermost_frame; frame--) {
- c_node_type expected_type;
- void* pc = frames->contents[frame];
- CAMLassert (pc != (void*) Caml_state->last_return_address);
-
- if (!for_allocation) {
- expected_type = CALL;
- }
- else {
- expected_type = (frame > innermost_frame ? CALL : ALLOCATION);
- }
-
- if (*node_hole == Val_unit) {
- node = allocate_c_node();
- /* Note: for CALL nodes, the PC is the program counter at each call
- site. We do not store program counter addresses of the start of
- callees, unlike for OCaml nodes. This means that some trie nodes
- will become conflated. These can be split during post-processing by
- working out which function each call site was in. */
- node->pc = (expected_type == CALL ? Encode_c_node_pc_for_call(pc)
- : Encode_c_node_pc_for_alloc_point(pc));
- *node_hole = caml_spacetime_stored_pointer_of_c_node(node);
- if (expected_type == ALLOCATION) {
- must_initialise_node_for_allocation = 1;
- }
- }
- else {
- c_node* prev;
- int found = 0;
-
- node = caml_spacetime_c_node_of_stored_pointer_not_null(*node_hole);
- CAMLassert(node != NULL);
- CAMLassert(node->next == Val_unit
- || (((uintnat) (node->next)) % sizeof(value) == 0));
-
- prev = NULL;
-
- while (!found && node != NULL) {
- if (caml_spacetime_classify_c_node(node) == expected_type
- && pc_inside_c_node_matches(node, pc)) {
- found = 1;
- }
- else {
- prev = node;
- node = caml_spacetime_c_node_of_stored_pointer(node->next);
- }
- }
- if (!found) {
- CAMLassert(prev != NULL);
- node = allocate_c_node();
- node->pc = (expected_type == CALL ? Encode_c_node_pc_for_call(pc)
- : Encode_c_node_pc_for_alloc_point(pc));
- if (expected_type == ALLOCATION) {
- must_initialise_node_for_allocation = 1;
- }
- prev->next = caml_spacetime_stored_pointer_of_c_node(node);
- }
- }
-
- CAMLassert(node != NULL);
-
- CAMLassert(caml_spacetime_classify_c_node(node) == expected_type);
- CAMLassert(pc_inside_c_node_matches(node, pc));
- node_hole = &node->data.call.callee_node;
- }
-
- if (must_initialise_node_for_allocation) {
- caml_spacetime_profinfo++;
- if (caml_spacetime_profinfo > PROFINFO_MASK) {
- /* Profiling counter overflow. */
- caml_spacetime_profinfo = PROFINFO_MASK;
- }
- node->data.allocation.profinfo =
- Make_header_with_profinfo(
- /* "-1" because [c_node] has the GC header as its first
- element. */
- offsetof(c_node, data.allocation.count)/sizeof(value) - 1,
- Infix_tag,
- Caml_black,
- caml_spacetime_profinfo);
- node->data.allocation.count = Val_long(0);
-
- /* Add the new allocation point into the linked list of all allocation
- points. */
- if (caml_all_allocation_points != NULL) {
- node->data.allocation.next =
- (value) &caml_all_allocation_points->count;
- } else {
- node->data.allocation.next = Val_unit;
- }
- caml_all_allocation_points = &node->data.allocation;
- }
-
- if (for_allocation) {
- CAMLassert(caml_spacetime_classify_c_node(node) == ALLOCATION);
- CAMLassert(caml_spacetime_c_node_of_stored_pointer(node->next) != node);
- CAMLassert(Profinfo_hd(node->data.allocation.profinfo) > 0);
- node->data.allocation.count =
- Val_long(Long_val(node->data.allocation.count) + (1 + wosize));
- }
-
- CAMLassert(node->next != (value) NULL);
-
- return for_allocation ? (void*) node : (void*) node_hole;
-#else
- return NULL;
-#endif
-}
-
-void caml_spacetime_c_to_ocaml(void* ocaml_entry_point,
- void* identifying_pc_for_caml_start_program)
-{
- /* Called in [caml_start_program] and [caml_callback*] when we are about
- to cross from C into OCaml. [ocaml_entry_point] is the branch target.
- This situation is handled by ensuring the presence of a new OCaml node
- for the callback veneer; the node contains a single indirect call point
- which accumulates the [ocaml_entry_point]s.
-
- The layout of the node is described in the "system shape table"; see
- amd64.S.
- */
-
- value node;
-
- /* Update the trie with the current backtrace, as far back as
- [Caml_state->last_return_address], and leave the node hole pointer at
- the correct place for attachment of a [caml_start_program] node. */
-
-#ifdef HAS_LIBUNWIND
- value* node_temp;
- node_temp = (value*) find_trie_node_from_libunwind(0, 0, NULL);
- if (node_temp != NULL) {
- caml_spacetime_trie_node_ptr = node_temp;
- }
-#endif
-
- if (*caml_spacetime_trie_node_ptr == Val_unit) {
- uintnat size_including_header;
-
- size_including_header =
- 1 /* GC header */ + Node_num_header_words + Indirect_num_fields;
-
- node = allocate_uninitialized_ocaml_node(size_including_header);
- Hd_val(node) =
- Make_header(size_including_header - 1, OCaml_node_tag, Caml_black);
- CAMLassert((((uintnat) identifying_pc_for_caml_start_program) % 1) == 0);
- Node_pc(node) = Encode_node_pc(identifying_pc_for_caml_start_program);
- Tail_link(node) = node;
- Indirect_pc_linked_list(node, Node_num_header_words) = Val_unit;
- *caml_spacetime_trie_node_ptr = node;
- }
- else {
- node = *caml_spacetime_trie_node_ptr;
- /* If there is a node here already, it should never be an initialized
- (but as yet unused) tail call point, since calls from OCaml into C
- are never tail calls (and no C -> C call is marked as tail). */
- CAMLassert(!Is_tail_caller_node_encoded(node));
- }
-
- CAMLassert(Is_ocaml_node(node));
- CAMLassert(Decode_node_pc(Node_pc(node))
- == identifying_pc_for_caml_start_program);
- CAMLassert(Tail_link(node) == node);
- CAMLassert(Wosize_val(node) == Node_num_header_words + Indirect_num_fields);
-
- /* Search the node to find the node hole corresponding to the indirect
- call to the OCaml function. */
- caml_spacetime_trie_node_ptr =
- caml_spacetime_indirect_node_hole_ptr(
- ocaml_entry_point,
- &Indirect_pc_linked_list(node, Node_num_header_words),
- Val_unit);
- CAMLassert(*caml_spacetime_trie_node_ptr == Val_unit
- || Is_ocaml_node(*caml_spacetime_trie_node_ptr));
-}
-
-extern void caml_garbage_collection(void); /* signals_nat.c */
-extern void caml_array_bound_error(void); /* fail.c */
-
-CAMLprim uintnat caml_spacetime_generate_profinfo (void* profinfo_words,
- uintnat index_within_node)
-{
- /* Called from code that creates a value's header inside an OCaml
- function. */
-
- value node;
- uintnat profinfo;
-
- caml_spacetime_profinfo++;
- if (caml_spacetime_profinfo > PROFINFO_MASK) {
- /* Profiling counter overflow. */
- caml_spacetime_profinfo = PROFINFO_MASK;
- }
- profinfo = caml_spacetime_profinfo;
-
- /* CR-someday mshinwell: we could always use the [struct allocation_point]
- overlay instead of the macros now. */
-
- /* [node] isn't really a node; it points into the middle of
- one---specifically to the "profinfo" word of an allocation point.
- It's done like this to avoid re-calculating the place in the node
- (which already has to be done in the OCaml-generated code run before
- this function). */
- node = (value) profinfo_words;
- CAMLassert(Alloc_point_profinfo(node, 0) == Val_unit);
-
- /* The profinfo value is stored shifted to reduce the number of
- instructions required on the OCaml side. It also enables us to use
- [Infix_tag] to obtain valid value pointers into the middle of nodes,
- which is used for the linked list of all allocation points. */
- profinfo = Make_header_with_profinfo(
- index_within_node, Infix_tag, Caml_black, profinfo);
-
- CAMLassert(!Is_block(profinfo));
- Alloc_point_profinfo(node, 0) = profinfo;
- /* The count is set to zero by the initialisation when the node was
- created (see above). */
- CAMLassert(Alloc_point_count(node, 0) == Val_long(0));
-
- /* Add the new allocation point into the linked list of all allocation
- points. */
- if (caml_all_allocation_points != NULL) {
- Alloc_point_next_ptr(node, 0) = (value) &caml_all_allocation_points->count;
- }
- else {
- CAMLassert(Alloc_point_next_ptr(node, 0) == Val_unit);
- }
- caml_all_allocation_points = (allocation_point*) node;
-
- return profinfo;
-}
-
-uintnat caml_spacetime_my_profinfo (struct ext_table** cached_frames,
- uintnat wosize)
-{
- /* Return the profinfo value that should be written into a value's header
- during an allocation from C. This may necessitate extending the trie
- with information obtained from libunwind. */
-
- c_node* node;
- uintnat profinfo = 0;
-
- node = find_trie_node_from_libunwind(1, wosize, cached_frames);
- if (node != NULL) {
- profinfo = ((uintnat) (node->data.allocation.profinfo)) >> PROFINFO_SHIFT;
- }
-
- return profinfo; /* N.B. not shifted by PROFINFO_SHIFT */
-}
-
-void caml_spacetime_automatic_snapshot (void)
-{
- if (automatic_snapshots) {
- double start_time, end_time;
- start_time = caml_sys_time_unboxed(Val_unit);
- if (start_time >= next_snapshot_time) {
- maybe_reopen_snapshot_channel();
- caml_spacetime_save_snapshot(snapshot_channel, 0.0, 0);
- end_time = caml_sys_time_unboxed(Val_unit);
- next_snapshot_time = end_time + snapshot_interval;
- }
- }
-}
-
-CAMLprim value caml_spacetime_save_event_for_automatic_snapshots
- (value v_event_name)
-{
- if (automatic_snapshots) {
- maybe_reopen_snapshot_channel();
- caml_spacetime_save_event_internal (Val_unit, snapshot_channel,
- v_event_name);
- }
- return Val_unit;
-}
-
-void caml_spacetime_automatic_save (void)
-{
- /* Called from [atexit]. */
-
- if (automatic_snapshots) {
- automatic_snapshots = 0;
- maybe_reopen_snapshot_channel();
- save_trie(snapshot_channel, 0.0, 0);
- caml_flush(snapshot_channel);
- caml_close_channel(snapshot_channel);
- }
-}
-
-CAMLprim value caml_spacetime_enabled (value v_unit)
-{
- return Val_true;
-}
-
-CAMLprim value caml_register_channel_for_spacetime (value v_channel)
-{
- struct channel* channel = Channel(v_channel);
- channel->flags |= CHANNEL_FLAG_BLOCKING_WRITE;
- return Val_unit;
-}
-
-#else
-
-/* Functions for when the compiler was not configured with "-spacetime". */
-
-CAMLprim value caml_spacetime_write_magic_number(value v_channel)
-{
- return Val_unit;
-}
-
-CAMLprim value caml_spacetime_enabled (value v_unit)
-{
- return Val_false;
-}
-
-CAMLprim value caml_spacetime_save_event (value v_time_opt,
- value v_channel,
- value v_event_name)
-{
- return Val_unit;
-}
-
-CAMLprim value caml_spacetime_save_event_for_automatic_snapshots
- (value v_event_name)
-{
- return Val_unit;
-}
-
-CAMLprim value caml_spacetime_save_trie (value ignored)
-{
- return Val_unit;
-}
-
-CAMLprim value caml_register_channel_for_spacetime (value v_channel)
-{
- return Val_unit;
-}
-
-#endif
+++ /dev/null
-/**************************************************************************/
-/* */
-/* OCaml */
-/* */
-/* Mark Shinwell and Leo White, Jane Street Europe */
-/* */
-/* Copyright 2013--2016, Jane Street Group, LLC */
-/* */
-/* All rights reserved. This file is distributed under the terms of */
-/* the GNU Lesser General Public License version 2.1, with the */
-/* special exception on linking described in the file LICENSE. */
-/* */
-/**************************************************************************/
-
-#define CAML_INTERNALS
-
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <limits.h>
-#include <math.h>
-
-#include "caml/alloc.h"
-#include "caml/backtrace_prim.h"
-#include "caml/config.h"
-#include "caml/custom.h"
-#include "caml/fail.h"
-#include "caml/gc.h"
-#include "caml/gc_ctrl.h"
-#include "caml/intext.h"
-#include "caml/major_gc.h"
-#include "caml/memory.h"
-#include "caml/minor_gc.h"
-#include "caml/misc.h"
-#include "caml/mlvalues.h"
-#include "caml/roots.h"
-#include "caml/signals.h"
-#include "caml/stack.h"
-#include "caml/sys.h"
-#include "caml/spacetime.h"
-
-#ifdef WITH_SPACETIME
-
-/* The following structures must match the type definitions in the
- [Spacetime] module. */
-
-typedef struct {
- /* (GC header here.) */
- value minor_words;
- value promoted_words;
- value major_words;
- value minor_collections;
- value major_collections;
- value heap_words;
- value heap_chunks;
- value compactions;
- value top_heap_words;
-} gc_stats;
-
-typedef struct {
- value profinfo;
- value num_blocks;
- value num_words_including_headers;
-} snapshot_entry;
-
-typedef struct {
- /* (GC header here.) */
- snapshot_entry entries[0];
-} snapshot_entries;
-
-typedef struct {
- /* (GC header here.) */
- value time;
- value gc_stats;
- value entries;
- value words_scanned;
- value words_scanned_with_profinfo;
- value total_allocations;
-} snapshot;
-
-typedef struct {
- uintnat num_blocks;
- uintnat num_words_including_headers;
-} raw_snapshot_entry;
-
-static value allocate_outside_heap_with_tag(mlsize_t size_in_bytes, tag_t tag)
-{
- /* CR-soon mshinwell: this function should live somewhere else */
- header_t* block;
-
- CAMLassert(size_in_bytes % sizeof(value) == 0);
- block = caml_stat_alloc(sizeof(header_t) + size_in_bytes);
- *block = Make_header(size_in_bytes / sizeof(value), tag, Caml_black);
- return (value) &block[1];
-}
-
-static value allocate_outside_heap(mlsize_t size_in_bytes)
-{
- CAMLassert(size_in_bytes > 0);
- return allocate_outside_heap_with_tag(size_in_bytes, 0);
-}
-
-static value take_gc_stats(void)
-{
- value v_stats;
- gc_stats* stats;
-
- v_stats = allocate_outside_heap(sizeof(gc_stats));
- stats = (gc_stats*) v_stats;
-
- stats->minor_words = Val_long(Caml_state->stat_minor_words);
- stats->promoted_words = Val_long(Caml_state->stat_promoted_words);
- stats->major_words =
- Val_long(((uintnat) Caml_state->stat_major_words)
- + ((uintnat) caml_allocated_words));
- stats->minor_collections = Val_long(Caml_state->stat_minor_collections);
- stats->major_collections = Val_long(Caml_state->stat_major_collections);
- stats->heap_words = Val_long(Caml_state->stat_heap_wsz / sizeof(value));
- stats->heap_chunks = Val_long(Caml_state->stat_heap_chunks);
- stats->compactions = Val_long(Caml_state->stat_compactions);
- stats->top_heap_words =
- Val_long(Caml_state->stat_top_heap_wsz / sizeof(value));
-
- return v_stats;
-}
-
-static value get_total_allocations(void)
-{
- value v_total_allocations = Val_unit;
- allocation_point* total = caml_all_allocation_points;
-
- while (total != NULL) {
- value v_total;
- v_total = allocate_outside_heap_with_tag(3 * sizeof(value), 0);
-
- /* [v_total] is of type [Raw_spacetime_lib.total_allocations]. */
- Field(v_total, 0) = Val_long(Profinfo_hd(total->profinfo));
- Field(v_total, 1) = total->count;
- Field(v_total, 2) = v_total_allocations;
- v_total_allocations = v_total;
-
- CAMLassert (total->next == Val_unit
- || (Is_block(total->next) && Tag_val(total->next) == Infix_tag));
- if (total->next == Val_unit) {
- total = NULL;
- }
- else {
- total = (allocation_point*) Hp_val(total->next);
- }
- }
-
- return v_total_allocations;
-}
-
-static value take_snapshot(double time_override, int use_time_override)
-{
- value v_snapshot;
- snapshot* heap_snapshot;
- value v_entries;
- snapshot_entries* entries;
- char* chunk;
- value gc_stats;
- uintnat index;
- uintnat target_index;
- value v_time;
- double time;
- uintnat profinfo;
- uintnat num_distinct_profinfos;
- /* Fixed size buffer to avoid needing a hash table: */
- static raw_snapshot_entry* raw_entries = NULL;
- uintnat words_scanned = 0;
- uintnat words_scanned_with_profinfo = 0;
- value v_total_allocations;
-
- if (!use_time_override) {
- time = caml_sys_time_unboxed(Val_unit);
- }
- else {
- time = time_override;
- }
-
- gc_stats = take_gc_stats();
-
- if (raw_entries == NULL) {
- size_t size = (PROFINFO_MASK + 1) * sizeof(raw_snapshot_entry);
- raw_entries = caml_stat_alloc(size);
- memset(raw_entries, '\0', size);
- } else {
- size_t size = (PROFINFO_MASK + 1) * sizeof(raw_snapshot_entry);
- memset(raw_entries, '\0', size);
- }
-
- num_distinct_profinfos = 0;
-
- /* CR-someday mshinwell: consider reintroducing minor heap scanning,
- properly from roots, which would then give a snapshot function
- that doesn't do a minor GC. Although this may not be that important
- and potentially not worth the effort (it's quite tricky). */
-
- /* Scan the major heap. */
- chunk = caml_heap_start;
- while (chunk != NULL) {
- char* hp;
- char* limit;
-
- hp = chunk;
- limit = chunk + Chunk_size (chunk);
-
- while (hp < limit) {
- header_t hd = Hd_hp (hp);
- switch (Color_hd(hd)) {
- case Caml_blue:
- break;
-
- default:
- if (Wosize_hd(hd) > 0) { /* ignore atoms */
- profinfo = Profinfo_hd(hd);
- words_scanned += Whsize_hd(hd);
- if (profinfo > 0 && profinfo < PROFINFO_MASK) {
- words_scanned_with_profinfo += Whsize_hd(hd);
- CAMLassert (raw_entries[profinfo].num_blocks >= 0);
- if (raw_entries[profinfo].num_blocks == 0) {
- num_distinct_profinfos++;
- }
- raw_entries[profinfo].num_blocks++;
- raw_entries[profinfo].num_words_including_headers +=
- Whsize_hd(hd);
- }
- }
- break;
- }
- hp += Bhsize_hd (hd);
- CAMLassert (hp <= limit);
- }
-
- chunk = Chunk_next (chunk);
- }
-
- if (num_distinct_profinfos > 0) {
- v_entries = allocate_outside_heap(
- num_distinct_profinfos*sizeof(snapshot_entry));
- entries = (snapshot_entries*) v_entries;
- target_index = 0;
- for (index = 0; index <= PROFINFO_MASK; index++) {
- CAMLassert(raw_entries[index].num_blocks >= 0);
- if (raw_entries[index].num_blocks > 0) {
- CAMLassert(target_index < num_distinct_profinfos);
- entries->entries[target_index].profinfo = Val_long(index);
- entries->entries[target_index].num_blocks
- = Val_long(raw_entries[index].num_blocks);
- entries->entries[target_index].num_words_including_headers
- = Val_long(raw_entries[index].num_words_including_headers);
- target_index++;
- }
- }
- } else {
- v_entries = Atom(0);
- }
-
- CAMLassert(sizeof(double) == sizeof(value));
- v_time = allocate_outside_heap_with_tag(sizeof(double), Double_tag);
- Store_double_val(v_time, time);
-
- v_snapshot = allocate_outside_heap(sizeof(snapshot));
- heap_snapshot = (snapshot*) v_snapshot;
-
- v_total_allocations = get_total_allocations();
-
- heap_snapshot->time = v_time;
- heap_snapshot->gc_stats = gc_stats;
- heap_snapshot->entries = v_entries;
- heap_snapshot->words_scanned
- = Val_long(words_scanned);
- heap_snapshot->words_scanned_with_profinfo
- = Val_long(words_scanned_with_profinfo);
- heap_snapshot->total_allocations = v_total_allocations;
-
- return v_snapshot;
-}
-
-void caml_spacetime_save_snapshot (struct channel *chan, double time_override,
- int use_time_override)
-{
- value v_snapshot;
- value v_total_allocations;
- snapshot* heap_snapshot;
-
- Lock(chan);
-
- v_snapshot = take_snapshot(time_override, use_time_override);
-
- caml_output_val(chan, Val_long(0), Val_long(0));
-
- caml_extern_allow_out_of_heap = 1;
- caml_output_val(chan, v_snapshot, Val_long(0));
- caml_extern_allow_out_of_heap = 0;
-
- Unlock(chan);
-
- heap_snapshot = (snapshot*) v_snapshot;
- caml_stat_free(Hp_val(heap_snapshot->time));
- caml_stat_free(Hp_val(heap_snapshot->gc_stats));
- if (Wosize_val(heap_snapshot->entries) > 0) {
- caml_stat_free(Hp_val(heap_snapshot->entries));
- }
- v_total_allocations = heap_snapshot->total_allocations;
- while (v_total_allocations != Val_unit) {
- value next = Field(v_total_allocations, 2);
- caml_stat_free(Hp_val(v_total_allocations));
- v_total_allocations = next;
- }
-
- caml_stat_free(Hp_val(v_snapshot));
-}
-
-CAMLprim value caml_spacetime_take_snapshot(value v_time_opt, value v_channel)
-{
- struct channel * channel = Channel(v_channel);
- double time_override = 0.0;
- int use_time_override = 0;
-
- if (Is_block(v_time_opt)) {
- time_override = Double_field(Field(v_time_opt, 0), 0);
- use_time_override = 1;
- }
-
- caml_spacetime_save_snapshot(channel, time_override, use_time_override);
-
- return Val_unit;
-}
-
-extern struct custom_operations caml_int64_ops; /* ints.c */
-
-static value
-allocate_int64_outside_heap(uint64_t i)
-{
- value v;
-
- v = allocate_outside_heap_with_tag(2 * sizeof(value), Custom_tag);
- Custom_ops_val(v) = &caml_int64_ops;
- Int64_val(v) = i;
-
- return v;
-}
-
-static value
-copy_string_outside_heap(char const *s)
-{
- int len;
- mlsize_t wosize, offset_index;
- value result;
-
- len = strlen(s);
- wosize = (len + sizeof (value)) / sizeof (value);
- result = allocate_outside_heap_with_tag(wosize * sizeof(value), String_tag);
-
- Field (result, wosize - 1) = 0;
- offset_index = Bsize_wsize (wosize) - 1;
- Byte (result, offset_index) = offset_index - len;
- memmove(Bytes_val(result), s, len);
-
- return result;
-}
-
-static value
-allocate_loc_outside_heap(struct caml_loc_info li)
-{
- value result;
-
- if (li.loc_valid) {
- result = allocate_outside_heap_with_tag(5 * sizeof(value), 0);
- Field(result, 0) = Val_bool(li.loc_is_raise);
- Field(result, 1) = copy_string_outside_heap(li.loc_filename);
- Field(result, 2) = Val_int(li.loc_lnum);
- Field(result, 3) = Val_int(li.loc_startchr);
- Field(result, 4) = Val_int(li.loc_endchr);
- } else {
- result = allocate_outside_heap_with_tag(sizeof(value), 1);
- Field(result, 0) = Val_bool(li.loc_is_raise);
- }
-
- return result;
-}
-
-value caml_spacetime_timestamp(double time_override, int use_time_override)
-{
- double time;
- value v_time;
-
- if (!use_time_override) {
- time = caml_sys_time_unboxed(Val_unit);
- }
- else {
- time = time_override;
- }
-
- v_time = allocate_outside_heap_with_tag(sizeof(double), Double_tag);
- Store_double_val(v_time, time);
-
- return v_time;
-}
-
-value caml_spacetime_frame_table(void)
-{
- /* Flatten the frame table into a single associative list. */
-
- value list = Val_long(0); /* the empty list */
- uintnat i;
-
- if (!caml_debug_info_available()) {
- return list;
- }
-
- if (caml_frame_descriptors == NULL) {
- caml_init_frame_descriptors();
- }
-
- for (i = 0; i <= caml_frame_descriptors_mask; i++) {
- frame_descr* descr = caml_frame_descriptors[i];
- if (descr != NULL) {
- value location, return_address, pair, new_list_element, location_list;
- struct caml_loc_info li;
- debuginfo dbg;
- if (descr->frame_size != 0xffff) {
- dbg = caml_debuginfo_extract(descr);
- if (dbg != NULL) {
- location_list = Val_unit;
- while (dbg != NULL) {
- value list_element;
-
- caml_debuginfo_location(dbg, &li);
- location = allocate_loc_outside_heap(li);
-
- list_element =
- allocate_outside_heap_with_tag(2 * sizeof(value), 0 /* (::) */);
- Field(list_element, 0) = location;
- Field(list_element, 1) = location_list;
- location_list = list_element;
-
- dbg = caml_debuginfo_next(dbg);
- }
-
- return_address = allocate_int64_outside_heap(descr->retaddr);
- pair = allocate_outside_heap_with_tag(2 * sizeof(value), 0);
- Field(pair, 0) = return_address;
- Field(pair, 1) = location_list;
-
- new_list_element =
- allocate_outside_heap_with_tag(2 * sizeof(value), 0 /* (::) */);
- Field(new_list_element, 0) = pair;
- Field(new_list_element, 1) = list;
- list = new_list_element;
- }
- }
- }
- }
-
- return list;
-}
-
-static void add_unit_to_shape_table(uint64_t *unit_table, value *list)
-{
- /* This function reverses the order of the lists giving the layout of each
- node; however, spacetime_profiling.ml ensures they are emitted in
- reverse order, so at the end of it all they're not reversed. */
-
- uint64_t* ptr = unit_table;
-
- while (*ptr != (uint64_t) 0) {
- value new_list_element, pair, function_address, layout;
-
- function_address =
- allocate_int64_outside_heap(*ptr++);
-
- layout = Val_long(0); /* the empty list */
- while (*ptr != (uint64_t) 0) {
- int tag;
- int stored_tag;
- value part_of_shape;
- value new_part_list_element;
- value location;
- int has_extra_argument = 0;
-
- stored_tag = *ptr++;
- /* CR-soon mshinwell: share with emit.mlp */
- switch (stored_tag) {
- case 1: /* direct call to given location */
- tag = 0;
- has_extra_argument = 1; /* the address of the callee */
- break;
-
- case 2: /* indirect call to given location */
- tag = 1;
- break;
-
- case 3: /* allocation at given location */
- tag = 2;
- break;
-
- default:
- CAMLassert(0);
- abort(); /* silence compiler warning */
- }
-
- location = allocate_int64_outside_heap(*ptr++);
-
- part_of_shape = allocate_outside_heap_with_tag(
- sizeof(value) * (has_extra_argument ? 2 : 1), tag);
- Field(part_of_shape, 0) = location;
- if (has_extra_argument) {
- Field(part_of_shape, 1) =
- allocate_int64_outside_heap(*ptr++);
- }
-
- new_part_list_element =
- allocate_outside_heap_with_tag(2 * sizeof(value), 0 /* (::) */);
- Field(new_part_list_element, 0) = part_of_shape;
- Field(new_part_list_element, 1) = layout;
- layout = new_part_list_element;
- }
-
- pair = allocate_outside_heap_with_tag(2 * sizeof(value), 0);
- Field(pair, 0) = function_address;
- Field(pair, 1) = layout;
-
- new_list_element =
- allocate_outside_heap_with_tag(2 * sizeof(value), 0 /* (::) */);
- Field(new_list_element, 0) = pair;
- Field(new_list_element, 1) = *list;
- *list = new_list_element;
-
- ptr++;
- }
-}
-
-value caml_spacetime_shape_table(void)
-{
- value list;
- uint64_t* unit_table;
- shape_table *dynamic_table;
- uint64_t** static_table;
-
- /* Flatten the hierarchy of shape tables into a single associative list
- mapping from function symbols to node layouts. The node layouts are
- themselves lists. */
-
- list = Val_long(0); /* the empty list */
-
- /* Add static shape tables */
- static_table = caml_spacetime_static_shape_tables;
- while (*static_table != (uint64_t) 0) {
- unit_table = *static_table++;
- add_unit_to_shape_table(unit_table, &list);
- }
-
- /* Add dynamic shape tables */
- dynamic_table = caml_spacetime_dynamic_shape_tables;
-
- while (dynamic_table != NULL) {
- unit_table = dynamic_table->table;
- add_unit_to_shape_table(unit_table, &list);
- dynamic_table = dynamic_table->next;
- }
-
- return list;
-}
-
-#else
-
-static value spacetime_disabled()
-{
- caml_failwith("Spacetime profiling not enabled");
-}
-
-CAMLprim value caml_spacetime_take_snapshot(value ignored)
-{
- return Val_unit;
-}
-
-CAMLprim value caml_spacetime_marshal_frame_table ()
-{
- return spacetime_disabled();
-}
-
-CAMLprim value caml_spacetime_frame_table ()
-{
- return spacetime_disabled();
-}
-
-CAMLprim value caml_spacetime_marshal_shape_table ()
-{
- return spacetime_disabled();
-}
-
-CAMLprim value caml_spacetime_shape_table ()
-{
- return spacetime_disabled();
-}
-
-#endif
{
asize_t size;
value * new_low, * new_high, * new_sp;
- value * p;
CAMLassert(Caml_state->extern_sp >= Caml_state->stack_low);
size = Caml_state->stack_high - Caml_state->stack_low;
caml_stat_free(Caml_state->stack_low);
Caml_state->trapsp = (value *) shift(Caml_state->trapsp);
Caml_state->trap_barrier = (value *) shift(Caml_state->trap_barrier);
- for (p = Caml_state->trapsp; p < new_high; p = Trap_link(p))
- Trap_link(p) = (value *) shift(Trap_link(p));
Caml_state->stack_low = new_low;
Caml_state->stack_high = new_high;
Caml_state->stack_threshold =
#endif
#include "caml/osdeps.h"
#include "caml/startup_aux.h"
-#include "caml/memprof.h"
#ifdef _WIN32
caml_stat_alloc_aligned_noexc(request, 0, &b);
for(i = 0; i < 256; i++) {
-#ifdef NATIVE_CODE
- caml_atom_table[i] = Make_header_allocated_here(0, i, Caml_white);
-#else
- caml_atom_table[i] = Make_header(0, i, Caml_white);
-#endif
+ caml_atom_table[i] = Make_header(0, i, Caml_black);
}
if (caml_page_table_add(In_static_data,
caml_atom_table, caml_atom_table + 256 + 1) != 0) {
switch (*opt++){
case 'a': scanmult (opt, &p); caml_set_allocation_policy ((intnat) p);
break;
- case 'b': scanmult (opt, &p); caml_record_backtrace(Val_bool (p));
+ case 'b': scanmult (opt, &p); caml_record_backtrace(Val_int (p));
break;
case 'c': scanmult (opt, &p); caml_cleanup_on_exit = (p != 0); break;
case 'h': scanmult (opt, &caml_init_heap_wsz); break;
case 'v': scanmult (opt, &caml_verb_gc); break;
case 'w': scanmult (opt, &caml_init_major_window); break;
case 'W': scanmult (opt, &caml_runtime_warnings); break;
+ case ',': continue;
}
while (*opt != '\0'){
if (*opt++ == ',') break;
call_registered_value("Pervasives.do_at_exit");
call_registered_value("Thread.at_shutdown");
caml_finalise_heap();
- caml_memprof_shutdown();
caml_free_locale();
#ifndef NATIVE_CODE
caml_free_shared_libs();
/* Start-up code */
+#include <errno.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
if (fd == -1) {
caml_stat_free(truename);
caml_gc_message(0x100, "Cannot open file\n");
- return FILE_NOT_FOUND;
+ if (errno == EMFILE)
+ return NO_FDS;
+ else
+ return FILE_NOT_FOUND;
}
if (!do_open_script) {
err = read (fd, buf, 2);
return i;
}
-extern void caml_init_ieee_floats (void);
-
#ifdef _WIN32
extern void caml_signal_thread(void * lpParam);
#endif
#endif
-extern int caml_ensure_spacetime_dot_o_is_included;
-
/* Main entry point when loading code from a file */
CAMLexport void caml_main(char_os **argv)
char_os * shared_lib_path, * shared_libs;
char_os * exe_name, * proc_self_exe;
- caml_ensure_spacetime_dot_o_is_included++;
-
/* Initialize the domain */
caml_init_domain();
if (!caml_startup_aux(/* pooling */ caml_cleanup_on_exit))
return;
- /* Machine-dependent initialization of the floating-point hardware
- so that it behaves as much as possible as specified in IEEE */
- caml_init_ieee_floats();
caml_init_locale();
#if defined(_MSC_VER) && __STDC_SECURE_LIB__ >= 200411L
caml_install_invalid_parameter_handler();
/* Load the globals */
caml_seek_section(fd, &trail, "DATA");
chan = caml_open_descriptor_in(fd);
+ Lock(chan);
caml_global_data = caml_input_val(chan);
+ Unlock(chan);
caml_close_channel(chan); /* this also closes fd */
caml_stat_free(trail.section);
/* Ensure that the globals are in the major heap. */
caml_oldify_mopup ();
/* Initialize system libraries */
caml_sys_init(exe_name, argv + pos);
+ /* Load debugging info, if b>=2 */
+ caml_load_main_debug_info();
#ifdef _WIN32
/* Start a thread to handle signals */
if (caml_secure_getenv(T("CAMLSIGPIPE")))
if (!caml_startup_aux(pooling))
return Val_unit;
- caml_init_ieee_floats();
caml_init_locale();
#if defined(_MSC_VER) && __STDC_SECURE_LIB__ >= 200411L
caml_install_invalid_parameter_handler();
caml_section_table_size = section_table_size;
/* Initialize system libraries */
caml_sys_init(exe_name, argv);
+ /* Load debugging info, if b>=2 */
+ caml_load_main_debug_info();
/* Execute the program */
caml_debugger(PROGRAM_START, Val_unit);
return caml_interprete(caml_start_code, caml_code_size);
#include "caml/stack.h"
#include "caml/startup_aux.h"
#include "caml/sys.h"
-#ifdef WITH_SPACETIME
-#include "caml/spacetime.h"
-#endif
#ifdef HAS_UI
#include "caml/ui.h"
#endif
extern int caml_parser_trace;
-char * caml_code_area_start, * caml_code_area_end;
+extern char caml_system__code_begin, caml_system__code_end;
/* Initialize the atom table and the static data and code area limits. */
static void init_static(void)
{
extern struct segment caml_data_segments[], caml_code_segments[];
+
+ char * caml_code_area_start, * caml_code_area_end;
int i;
caml_init_atom_table ();
caml_register_code_fragment(caml_code_area_start,
caml_code_area_end,
DIGEST_LATER, NULL);
+ /* Also register the glue code written in assembly */
+ caml_register_code_fragment(&caml_system__code_begin,
+ &caml_system__code_end,
+ DIGEST_IGNORE, NULL);
}
/* These are termination hooks used by the systhreads library */
void (*caml_termination_hook)(void *) = NULL;
extern value caml_start_program (caml_domain_state*);
-extern void caml_init_ieee_floats (void);
extern void caml_init_signals (void);
#ifdef _WIN32
extern void caml_win32_overflow_detection (void);
if (!caml_startup_aux(pooling))
return Val_unit;
-#ifdef WITH_SPACETIME
- caml_spacetime_initialize();
-#endif
caml_init_frame_descriptors();
- caml_init_ieee_floats();
caml_init_locale();
#if defined(_MSC_VER) && __STDC_SECURE_LIB__ >= 200411L
caml_install_invalid_parameter_handler();
intnat heap_chunks = Caml_state->stat_heap_chunks;
intnat top_heap_words = Caml_state->stat_top_heap_wsz;
intnat cpct = Caml_state->stat_compactions;
+ intnat forcmajcoll = Caml_state->stat_forced_major_collections;
caml_gc_message(0x400, "allocated_words: %.0f\n", allocated_words);
caml_gc_message(0x400, "minor_words: %.0f\n", minwords);
caml_gc_message(0x400, "promoted_words: %.0f\n", prowords);
top_heap_words);
caml_gc_message(0x400, "compactions: %"ARCH_INTNAT_PRINTF_FORMAT"d\n",
cpct);
+ caml_gc_message(0x400,
+ "forced_major_collections: %"ARCH_INTNAT_PRINTF_FORMAT"d\n",
+ forcmajcoll);
}
#ifndef NATIVE_CODE
CAMLreturn(Val_unit);
}
+CAMLprim value caml_sys_mkdir(value path, value perm)
+{
+ CAMLparam2(path, perm);
+ char_os * p;
+ int ret;
+ caml_sys_check_path(path);
+ p = caml_stat_strdup_to_os(String_val(path));
+ caml_enter_blocking_section();
+ ret = mkdir_os(p, Int_val(perm));
+ caml_leave_blocking_section();
+ caml_stat_free(p);
+ if (ret == -1) caml_sys_error(path);
+ CAMLreturn(Val_unit);
+}
+
+CAMLprim value caml_sys_rmdir(value path)
+{
+ CAMLparam1(path);
+ char_os * p;
+ int ret;
+ caml_sys_check_path(path);
+ p = caml_stat_strdup_to_os(String_val(path));
+ caml_enter_blocking_section();
+ ret = rmdir_os(p);
+ caml_leave_blocking_section();
+ caml_stat_free(p);
+ if (ret == -1) caml_sys_error(path);
+ CAMLreturn(Val_unit);
+}
+
CAMLprim value caml_sys_getcwd(value unit)
{
char_os buff[4096];
#endif
#endif
+#ifdef HAS_SYSTEM
CAMLprim value caml_sys_system_command(value command)
{
CAMLparam1 (command);
retcode = 255;
CAMLreturn (Val_int(retcode));
}
+#else
+CAMLprim value caml_sys_system_command(value command)
+{
+ caml_invalid_argument("Sys.command not implemented");
+}
+#endif
double caml_sys_time_include_children_unboxed(value include_children)
{
return ret;
}
+
+CAMLprim value caml_sys_const_naked_pointers_checked(value unit)
+{
+#ifdef NAKED_POINTERS_CHECKER
+ return Val_true;
+#else
+ return Val_false;
+#endif
+}
int caml_read_fd(int fd, int flags, void * buf, int n)
{
int retcode;
- do {
- caml_enter_blocking_section();
- retcode = read(fd, buf, n);
- caml_leave_blocking_section();
- } while (retcode == -1 && errno == EINTR);
- if (retcode == -1) caml_sys_io_error(NO_ARG);
+ caml_enter_blocking_section_no_pending();
+ retcode = read(fd, buf, n);
+ caml_leave_blocking_section();
+ if (retcode == -1) {
+ if (errno == EINTR) return Io_interrupted;
+ else caml_sys_io_error(NO_ARG);
+ }
return retcode;
}
{
int retcode;
again:
-#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
- if (flags & CHANNEL_FLAG_BLOCKING_WRITE) {
- retcode = write(fd, buf, n);
- } else {
-#endif
- caml_enter_blocking_section();
+ caml_enter_blocking_section_no_pending();
retcode = write(fd, buf, n);
caml_leave_blocking_section();
-#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
- }
-#endif
if (retcode == -1) {
- if (errno == EINTR) goto again;
+ if (errno == EINTR) return Io_interrupted;
if ((errno == EAGAIN || errno == EWOULDBLOCK) && n > 1) {
/* We couldn't do a partial write here, probably because
n <= PIPE_BUF and POSIX says that writes of less than
CAMLassert (offset < Wosize_val (eph) - CAML_EPHE_FIRST_KEY); \
}while(0)
-#define CAMLassert_not_dead_value(v) do{ \
- CAMLassert ( caml_gc_phase != Phase_clean \
- || !Is_block(v) \
- || !Is_in_heap (v) \
- || !Is_white_val(v) ); \
+#ifdef DEBUG
+#define CAMLassert_not_dead_value(v) do{ \
+ value __v = v; \
+ if (caml_gc_phase == Phase_clean \
+ && Is_block(__v) \
+ && Is_in_heap (__v)) { \
+ if (Tag_val (__v) == Infix_tag) __v -= Infix_offset_val (__v); \
+ CAMLassert ( !Is_white_val(__v) ); \
+ } \
}while(0)
+#else
+#define CAMLassert_not_dead_value(v)
+#endif
CAMLexport mlsize_t caml_ephemeron_num_keys(value eph)
{
}
/** The minor heap is considered alive. */
-#if defined (NATIVE_CODE) && defined (NO_NAKED_POINTERS)
+
/** Outside minor and major heap, x must be black. */
Caml_inline int Is_Dead_during_clean(value x)
{
CAMLassert (x != caml_ephe_none);
CAMLassert (caml_gc_phase == Phase_clean);
- return Is_block (x) && !Is_young (x) && Is_white_val(x);
+#ifdef NO_NAKED_POINTERS
+ if (!Is_block(x) || Is_young (x)) return 0;
+#else
+ if (!Is_block(x) || !Is_in_heap(x)) return 0;
+#endif
+ if (Tag_val(x) == Infix_tag) x -= Infix_offset_val(x);
+ return Is_white_val(x);
}
/** The minor heap doesn't have to be marked, outside they should
already be black
{
CAMLassert (x != caml_ephe_none);
CAMLassert (caml_gc_phase == Phase_mark);
+#ifdef NO_NAKED_POINTERS
return Is_block (x) && !Is_young (x);
-}
#else
-Caml_inline int Is_Dead_during_clean(value x)
-{
- CAMLassert (x != caml_ephe_none);
- CAMLassert (caml_gc_phase == Phase_clean);
- return Is_block (x) && Is_in_heap (x) && Is_white_val(x);
-}
-Caml_inline int Must_be_Marked_during_mark(value x)
-{
- CAMLassert (x != caml_ephe_none);
- CAMLassert (caml_gc_phase == Phase_mark);
return Is_block (x) && Is_in_heap (x);
-}
#endif
+}
/* [len] is a number of words (fields) */
CAMLexport value caml_ephemeron_create (mlsize_t len)
return optionalize(caml_ephemeron_get_data(ar, &data), &data);
}
-
-Caml_inline void copy_value(value src, value dst)
+static void copy_value(value src, value dst)
{
- if (Tag_val (src) < No_scan_tag){
- mlsize_t i;
- for (i = 0; i < Wosize_val (src); i++){
- value f = Field (src, i);
- if (caml_gc_phase == Phase_mark && Must_be_Marked_during_mark(f)){
- caml_darken (f, NULL);
- }
- caml_modify (&Field (dst, i), f);
+ mlsize_t sz, i;
+ sz = Wosize_val(src);
+ if (Tag_val (src) >= No_scan_tag) {
+ /* Direct copy */
+ memcpy (Bp_val (dst), Bp_val (src), Bsize_wsize (sz));
+ return;
+ }
+ i = 0;
+ if (Tag_val (src) == Closure_tag) {
+ /* Direct copy of the code pointers and closure info fields */
+ i = Start_env_closinfo(Closinfo_val(src));
+ memcpy (Bp_val (dst), Bp_val (src), Bsize_wsize (i));
+ }
+ /* Field-by-field copy and darkening of the remaining fields */
+ for (/*nothing*/; i < sz; i++){
+ value f = Field (src, i);
+ if (caml_gc_phase == Phase_mark && Must_be_Marked_during_mark(f)){
+ caml_darken (f, NULL);
}
- }else{
- memmove (Bp_val (dst), Bp_val (src), Bosize_val (src));
+ caml_modify (&Field (dst, i), f);
}
}
CAMLexport int caml_ephemeron_get_key_copy(value ar, mlsize_t offset,
value *key)
{
- mlsize_t loop = 0;
+ mlsize_t loop = 0, infix_offs;
CAMLparam1(ar);
value elt = Val_unit, v; /* Caution: they are NOT local roots. */
CAMLassert_valid_offset(ar, offset);
if(is_ephe_key_none(ar, offset)) CAMLreturn(0);
v = Field (ar, offset);
/** Don't copy custom_block #7279 */
- if(!(Is_block (v) && Is_in_heap_or_young(v) && Tag_val(v) != Custom_tag)) {
+ if(!(Is_block (v) && Is_in_value_area(v) && Tag_val(v) != Custom_tag)) {
if ( caml_gc_phase == Phase_mark && Must_be_Marked_during_mark(v) ){
caml_darken (v, NULL);
};
*key = v;
CAMLreturn(1);
}
+ infix_offs = Tag_val(v) == Infix_tag ? Infix_offset_val(v) : 0;
+ v -= infix_offs;
if (elt != Val_unit &&
Wosize_val(v) == Wosize_val(elt) && Tag_val(v) == Tag_val(elt)) {
/* The allocation may trigger a finaliser that change the tag
*/
CAMLassert_not_dead_value(v);
copy_value(v, elt);
- *key = elt;
+ *key = elt + infix_offs;
CAMLreturn(1);
}
CAMLexport int caml_ephemeron_get_data_copy (value ar, value *data)
{
- mlsize_t loop = 0;
+ mlsize_t loop = 0, infix_offs;
CAMLparam1 (ar);
value elt = Val_unit, v; /* Caution: they are NOT local roots. */
CAMLassert_valid_ephemeron(ar);
v = Field (ar, CAML_EPHE_DATA_OFFSET);
if (v == caml_ephe_none) CAMLreturn(0);
/** Don't copy custom_block #7279 */
- if (!(Is_block (v) && Is_in_heap_or_young(v) && Tag_val(v) != Custom_tag)) {
+ if (!(Is_block (v) && Is_in_value_area(v) && Tag_val(v) != Custom_tag)) {
if ( caml_gc_phase == Phase_mark && Must_be_Marked_during_mark(v) ){
caml_darken (v, NULL);
};
*data = v;
CAMLreturn(1);
}
+ infix_offs = Tag_val(v) == Infix_tag ? Infix_offset_val(v) : 0;
+ v -= infix_offs;
if (elt != Val_unit &&
Wosize_val(v) == Wosize_val(elt) && Tag_val(v) == Tag_val(elt)) {
/** cf caml_ephemeron_get_key_copy */
CAMLassert_not_dead_value(v);
copy_value(v, elt);
- *data = elt;
+ *data = elt + infix_offs;
CAMLreturn(1);
}
#include <string.h>
#include <signal.h>
#include "caml/alloc.h"
-#include "caml/address_class.h"
+#include "caml/codefrag.h"
#include "caml/fail.h"
#include "caml/io.h"
#include "caml/memory.h"
{
int retcode;
if ((flags & CHANNEL_FLAG_FROM_SOCKET) == 0) {
- caml_enter_blocking_section();
+ caml_enter_blocking_section_no_pending();
retcode = read(fd, buf, n);
/* Large reads from console can fail with ENOMEM. Reduce requested size
and try again. */
caml_leave_blocking_section();
if (retcode == -1) caml_sys_io_error(NO_ARG);
} else {
- caml_enter_blocking_section();
+ caml_enter_blocking_section_no_pending();
retcode = recv((SOCKET) _get_osfhandle(fd), buf, n, 0);
caml_leave_blocking_section();
if (retcode == -1) caml_win32_sys_error(WSAGetLastError());
{
int retcode;
if ((flags & CHANNEL_FLAG_FROM_SOCKET) == 0) {
-#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
- if (flags & CHANNEL_FLAG_BLOCKING_WRITE) {
- retcode = write(fd, buf, n);
- } else {
-#endif
- caml_enter_blocking_section();
+ caml_enter_blocking_section_no_pending();
retcode = write(fd, buf, n);
caml_leave_blocking_section();
-#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
- }
-#endif
if (retcode == -1) caml_sys_io_error(NO_ARG);
} else {
- caml_enter_blocking_section();
+ caml_enter_blocking_section_no_pending();
retcode = send((SOCKET) _get_osfhandle(fd), buf, n, 0);
caml_leave_blocking_section();
if (retcode == -1) caml_win32_sys_error(WSAGetLastError());
void * caml_globalsym(const char * name)
{
- return flexdll_dlsym(flexdll_dlopen(NULL,0), name);
+ return flexdll_dlsym(flexdll_wdlopen(NULL,0), name);
}
char * caml_dlerror(void)
the directory named [dirname]. No entries are added for [.] and [..].
Return 0 on success, -1 on error; set errno in the case of error. */
-int caml_read_directory(wchar_t * dirname, struct ext_table * contents)
+CAMLexport int caml_read_directory(wchar_t * dirname,
+ struct ext_table * contents)
{
size_t dirnamelen;
wchar_t * template;
DWORD *ctx_ip = &(ctx->Eip);
DWORD *ctx_sp = &(ctx->Esp);
- if (code == EXCEPTION_STACK_OVERFLOW && Is_in_code_area (*ctx_ip))
+ if (code == EXCEPTION_STACK_OVERFLOW &&
+ caml_find_code_fragment_by_pc((char *) (*ctx_ip)) != NULL)
{
uintnat faulting_address;
uintnat * alt_esp;
#else
-/* Do not use the macro from address_class.h here. */
-#undef Is_in_code_area
-#define Is_in_code_area(pc) \
- ( ((char *)(pc) >= caml_code_area_start && \
- (char *)(pc) <= caml_code_area_end) \
-|| ((char *)(pc) >= &caml_system__code_begin && \
- (char *)(pc) <= &caml_system__code_end) \
-|| (Classify_addr(pc) & In_code_area) )
-extern char caml_system__code_begin, caml_system__code_end;
-
-
static LONG CALLBACK
caml_stack_overflow_VEH (EXCEPTION_POINTERS* exn_info)
{
DWORD code = exn_info->ExceptionRecord->ExceptionCode;
CONTEXT *ctx = exn_info->ContextRecord;
- if (code == EXCEPTION_STACK_OVERFLOW && Is_in_code_area (ctx->Rip))
+ if (code == EXCEPTION_STACK_OVERFLOW &&
+ caml_find_code_fragment_by_pc((char *) (ctx->Rip)) != NULL)
{
uintnat faulting_address;
uintnat * alt_rsp;
stdlib__arrayLabels.cmi
stdlib__arrayLabels.cmi : \
stdlib__seq.cmi
+stdlib__atomic.cmo : \
+ camlinternalAtomic.cmi \
+ stdlib__atomic.cmi
+stdlib__atomic.cmx : \
+ camlinternalAtomic.cmx \
+ stdlib__atomic.cmi
+stdlib__atomic.cmi :
stdlib__bigarray.cmo : \
stdlib__sys.cmi \
stdlib__complex.cmi \
stdlib__obj.cmx \
stdlib__callback.cmi
stdlib__callback.cmi :
+camlinternalAtomic.cmo : \
+ camlinternalAtomic.cmi
+camlinternalAtomic.cmx : \
+ camlinternalAtomic.cmi
+camlinternalAtomic.cmi :
camlinternalFormat.cmo : \
stdlib__sys.cmi \
stdlib__string.cmi \
camlinternalFormatBasics.cmi
camlinternalFormatBasics.cmi :
camlinternalLazy.cmo : \
+ stdlib__sys.cmi \
stdlib__obj.cmi \
camlinternalLazy.cmi
camlinternalLazy.cmx : \
+ stdlib__sys.cmx \
stdlib__obj.cmx \
camlinternalLazy.cmi
camlinternalLazy.cmi :
camlinternalMod.cmo : \
stdlib__sys.cmi \
stdlib__obj.cmi \
+ stdlib__nativeint.cmi \
camlinternalOO.cmi \
stdlib__array.cmi \
camlinternalMod.cmi
camlinternalMod.cmx : \
stdlib__sys.cmx \
stdlib__obj.cmx \
+ stdlib__nativeint.cmx \
camlinternalOO.cmx \
stdlib__array.cmx \
camlinternalMod.cmi
stdlib__bytes.cmx \
stdlib__digest.cmi
stdlib__digest.cmi :
+stdlib__either.cmo : \
+ stdlib__either.cmi
+stdlib__either.cmx : \
+ stdlib__either.cmi
+stdlib__either.cmi :
stdlib__ephemeron.cmo : \
stdlib__sys.cmi \
stdlib__seq.cmi \
stdlib__string.cmi \
stdlib.cmi \
stdlib__stack.cmi \
+ stdlib__seq.cmi \
stdlib__queue.cmi \
stdlib__list.cmi \
stdlib__int.cmi \
stdlib__string.cmx \
stdlib.cmx \
stdlib__stack.cmx \
+ stdlib__seq.cmx \
stdlib__queue.cmx \
stdlib__list.cmx \
stdlib__int.cmx \
stdlib__format.cmi
stdlib__format.cmi : \
stdlib.cmi \
+ stdlib__seq.cmi \
stdlib__buffer.cmi
stdlib__fun.cmo : \
stdlib__printexc.cmi \
stdlib__list.cmo : \
stdlib__sys.cmi \
stdlib__seq.cmi \
+ stdlib__either.cmi \
stdlib__list.cmi
stdlib__list.cmx : \
stdlib__sys.cmx \
stdlib__seq.cmx \
+ stdlib__either.cmx \
stdlib__list.cmi
stdlib__list.cmi : \
- stdlib__seq.cmi
+ stdlib__seq.cmi \
+ stdlib__either.cmi
stdlib__listLabels.cmo : \
stdlib__list.cmi \
stdlib__listLabels.cmi
stdlib__list.cmx \
stdlib__listLabels.cmi
stdlib__listLabels.cmi : \
- stdlib__seq.cmi
+ stdlib__seq.cmi \
+ stdlib__either.cmi
stdlib__map.cmo : \
stdlib__seq.cmi \
stdlib__map.cmi
stdlib__nativeint.cmi :
stdlib__obj.cmo : \
stdlib__sys.cmi \
+ stdlib__nativeint.cmi \
stdlib__marshal.cmi \
stdlib__int32.cmi \
stdlib__obj.cmi
stdlib__obj.cmx : \
stdlib__sys.cmx \
+ stdlib__nativeint.cmx \
stdlib__marshal.cmx \
stdlib__int32.cmx \
stdlib__obj.cmi
stdlib__printf.cmi \
stdlib__obj.cmi \
stdlib__buffer.cmi \
+ stdlib__atomic.cmi \
stdlib__array.cmi \
stdlib__printexc.cmi
stdlib__printexc.cmx : \
stdlib__printf.cmx \
stdlib__obj.cmx \
stdlib__buffer.cmx \
+ stdlib__atomic.cmx \
stdlib__array.cmx \
stdlib__printexc.cmi
stdlib__printexc.cmi :
stdlib__set.cmi
stdlib__set.cmi : \
stdlib__seq.cmi
-stdlib__spacetime.cmo : \
- stdlib__gc.cmi \
- stdlib__spacetime.cmi
-stdlib__spacetime.cmx : \
- stdlib__gc.cmx \
- stdlib__spacetime.cmi
-stdlib__spacetime.cmi :
stdlib__stack.cmo : \
stdlib__seq.cmi \
stdlib__list.cmi \
stdlib__hashtbl.cmi
stdlib.cmo : \
camlinternalFormatBasics.cmi \
+ camlinternalAtomic.cmi \
stdlib.cmi
stdlib.cmx : \
camlinternalFormatBasics.cmx \
+ camlinternalAtomic.cmx \
stdlib.cmi
stdlib.cmi : \
camlinternalFormatBasics.cmi
stdlib.cm[iox])
echo ' -nopervasives -no-alias-deps -w -49' \
' -pp "$AWK -f ./expand_module_aliases.awk"';;
+ # stdlib dependencies
+ camlinternalFormatBasics*.cm[iox]) echo ' -nopervasives';;
+ camlinternalAtomic.cm[iox]) echo ' -nopervasives';;
+ # end stdlib dependencies
camlinternalOO.cmx) echo ' -inline 0 -afl-inst-ratio 0';;
camlinternalLazy.cmx) echo ' -afl-inst-ratio 0';;
# never instrument camlinternalOO or camlinternalLazy (PR#7725)
# make sure add_char is inlined (PR#5872)
stdlib__buffer.cm[io]) echo ' -w A';;
camlinternalFormat.cm[io]) echo ' -w Ae';;
- camlinternalFormatBasics*.cm[iox]) echo ' -nopervasives';;
stdlib__printf.cm[io]|stdlib__format.cm[io]|stdlib__scanf.cm[io])
echo ' -w Ae';;
stdlib__scanf.cmx) echo ' -inline 9';;
+ *Labels.cmi) echo ' -pp "$AWK -f ./expand_module_aliases.awk"';;
*Labels.cm[ox]) echo ' -nolabels -no-alias-deps';;
stdlib__float.cm[ox]) echo ' -nolabels -no-alias-deps';;
+ stdlib__oo.cmi) echo ' -no-principal';;
+ # preserve structure sharing in Oo.copy (PR#9767)
*) echo ' ';;
esac
* Create new `.mli` and `.ml` files for the modules, obviously.
* Define the module in `stdlib/stdlib.mli` and `stdlib/stdlib.ml` in
- the section of the code commented "MODULE ALIASES". Please maintain
+ the section of the code commented "MODULE_ALIASES". Please maintain
the same style as the rest of the code, in particular the
alphabetical ordering and whitespace alignment of module aliases.
ROOTDIR = ..
--include $(ROOTDIR)/Makefile.config
--include $(ROOTDIR)/Makefile.common
+include $(ROOTDIR)/Makefile.common
TARGET_BINDIR ?= $(BINDIR)
-COMPILER=$(ROOTDIR)/ocamlc
+COMPILER=$(ROOTDIR)/ocamlc$(EXE)
CAMLC=$(CAMLRUN) $(COMPILER)
COMPFLAGS=-strict-sequence -absname -w +a-4-9-41-42-44-45-48 \
- -g -warn-error A -bin-annot -nostdlib \
+ -g -warn-error A -bin-annot -nostdlib -principal \
-safe-string -strict-formats
ifeq "$(FLAMBDA)" "true"
OPTCOMPFLAGS += -O3
endif
-OPTCOMPILER=$(ROOTDIR)/ocamlopt
+OPTCOMPILER=$(ROOTDIR)/ocamlopt$(EXE)
CAMLOPT=$(CAMLRUN) $(OPTCOMPILER)
CAMLDEP=$(BOOT_OCAMLC) -depend
DEPFLAGS=-slash
include StdlibModules
OBJS=$(addsuffix .cmo,$(STDLIB_MODULES))
-OTHERS=$(filter-out camlinternalFormatBasics.cmo stdlib.cmo,$(OBJS))
+NOSTDLIB= camlinternalFormatBasics.cmo camlinternalAtomic.cmo stdlib.cmo
+OTHERS=$(filter-out $(NOSTDLIB),$(OBJS))
PREFIXED_OBJS=$(filter stdlib__%.cmo,$(OBJS))
UNPREFIXED_OBJS=$(PREFIXED_OBJS:stdlib__%.cmo=%)
allopt: stdlib.cmxa std_exit.cmx
opt.opt: allopt
-LEGACY_OBJS=$(patsubst stdlib__%,"$(INSTALL_LIBDIR)/%", \
- $(filter stdlib__%,$(OBJS)))
.PHONY: install
install::
-# Transitional: when upgrading from 4.06 -> 4.07, module M is in stdlib__m.cm*,
-# while previously it was in m.cm*, which confuses the compiler.
- rm -f $(LEGACY_OBJS)
-# Remove "old" pervasives.* and bigarray.* to avoid getting confused with the
-# Stdlib versions.
- rm -f "$(INSTALL_LIBDIR)/pervasives.*" "$(INSTALL_LIBDIR)/bigarray.*"
-# End transitional
$(INSTALL_DATA) \
stdlib.cma std_exit.cmo *.cmi camlheader_ur \
"$(INSTALL_LIBDIR)"
OC_CPPFLAGS += -DRUNTIME_NAME='"$(HEADER_PATH)ocamlrun$(subst .,,$*)"'
$(HEADERPROGRAM)%$(O): $(HEADERPROGRAM).c
- $(CC) -c $(OC_CFLAGS) $(OC_CPPFLAGS) $(OUTPUTOBJ)$@ $^
+ $(CC) -c $(OC_CFLAGS) $(CFLAGS) $(OC_CPPFLAGS) $(CPPFLAGS) \
+ $(OUTPUTOBJ)$@ $^
camlheader_ur: camlheader
cp camlheader $@
strip $@
$(TARGETHEADERPROGRAM)%$(O): $(HEADERPROGRAM).c
- $(CC) -c $(OC_CFLAGS) $(OC_CPPFLAGS) \
+ $(CC) -c $(OC_CFLAGS) $(CFLAGS) $(OC_CPPFLAGS) $(CPPFLAGS) \
-DRUNTIME_NAME='"$(HEADER_TARGET_PATH)ocamlrun$(subst .,,$*)"' \
$(OUTPUTOBJ)$@ $^
clean::
rm -f *.cm* *.o *.obj *.a *.lib *.odoc
- rm -f camlheader*
include .depend
# Modules should be listed in dependency order.
STDLIB_MODS=\
- camlinternalFormatBasics stdlib pervasives seq option result bool char uchar \
+ camlinternalFormatBasics camlinternalAtomic \
+ stdlib pervasives seq option either result bool char uchar \
sys list bytes string unit marshal obj array float int int32 int64 nativeint \
lexing parsing set map stack queue camlinternalLazy lazy stream buffer \
- camlinternalFormat printf arg printexc fun gc digest random hashtbl weak \
+ 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 spacetime bigarray
+ stdLabels bigarray
STDLIB_MODULES=\
$(foreach module, $(STDLIB_MODS), $(call add_stdlib_prefix,$(module)))
call the function with the symbol. *)
| Rest of (string -> unit) (* Stop interpreting keywords and call the
function with each remaining argument *)
+ | Rest_all of (string list -> unit)
+ (* Stop interpreting keywords and call the
+ function with all remaining arguments. *)
| Expand of (string -> string array) (* If the remaining arguments to process
are of the form
[["-foo"; "arg"] @ rest] where "foo"
f !argv.(!current + 1);
consume_arg ();
done;
+ | Rest_all f ->
+ no_arg ();
+ let acc = ref [] in
+ while !current < Array.length !argv - 1 do
+ acc := !argv.(!current + 1) :: !acc;
+ consume_arg ();
+ done;
+ f (List.rev !acc)
| Expand f ->
if not allow_expand then
raise (Invalid_argument "Arg.Expand is is only allowed with \
(** Parsing of command line arguments.
This module provides a general mechanism for extracting options and
- arguments from the command line to the program.
+ arguments from the command line to the program. For example:
+
+{[
+ let usage_msg = "append [-verbose] <file1> [<file2>] ... -o <output>"
+ let verbose = ref false
+ let input_files = ref []
+ let output_file = ref ""
+
+ let anon_fun filename =
+ input_files := filename::!input_files
+
+ let speclist =
+ [("-verbose", Arg.Set verbose, "Output debug information");
+ ("-o", Arg.Set_string output_file, "Set output file name")]
+
+ let () =
+ Arg.parse speclist anon_fun usage_msg;
+ (* Main functionality here *)
+]}
Syntax of command lines:
A keyword is a character string starting with a [-].
An option is a keyword alone or followed by an argument.
The types of keywords are: [Unit], [Bool], [Set], [Clear],
[String], [Set_string], [Int], [Set_int], [Float], [Set_float],
- [Tuple], [Symbol], and [Rest].
- [Unit], [Set] and [Clear] keywords take no argument. A [Rest]
- keyword takes the remaining of the command line as arguments.
+ [Tuple], [Symbol], [Rest], [Rest_all] and [Expand].
+
+ [Unit], [Set] and [Clear] keywords take no argument.
+
+ A [Rest] or [Rest_all] keyword takes the remainder of the command line
+ as arguments. (More explanations below.)
+
Every other keyword takes the following word on the command line
as argument. For compatibility with GNU getopt_long, [keyword=arg]
is also allowed.
- [cmd a b c ](three anonymous arguments: ["a"], ["b"], and ["c"])
- [cmd a b -- c d ](two anonymous arguments and a rest option with
two arguments)
+
+ [Rest] takes a function that is called repeatedly for each
+ remaining command line argument. [Rest_all] takes a function that
+ is called once, with the list of all remaining arguments.
+
+ Note that if no arguments follow a [Rest] keyword then the function
+ is not called at all whereas the function for a [Rest_all] keyword
+ is called with an empty list.
*)
type spec =
call the function with the symbol *)
| Rest of (string -> unit) (** Stop interpreting keywords and call the
function with each remaining argument *)
+ | Rest_all of (string list -> unit)
+ (** Stop interpreting keywords and call the
+ function with all remaining arguments *)
| Expand of (string -> string array) (** If the remaining arguments to process
are of the form
[["-foo"; "arg"] @ rest] where "foo"
(* *)
(**************************************************************************)
+(* NOTE:
+ If this file is arrayLabels.mli, run tools/sync_stdlib_docs after editing it
+ to generate array.mli.
+
+ If this file is array.mli, do not edit it directly -- edit
+ arrayLabels.mli instead.
+ *)
+
+(** Array operations.
+
+ The labeled version of this module can be used as described in the
+ {!StdLabels} module.
+*)
+
type 'a t = 'a array
(** An alias for the type of arrays. *)
-(** Array operations. *)
-
external length : 'a array -> int = "%array_length"
(** Return the length (number of elements) of the given array. *)
external get : 'a array -> int -> 'a = "%array_safe_get"
-(** [Array.get a n] returns the element number [n] of array [a].
+(** [get a n] returns the element number [n] of array [a].
The first element has number 0.
- The last element has number [Array.length a - 1].
- You can also write [a.(n)] instead of [Array.get a n].
+ The last element has number [length a - 1].
+ You can also write [a.(n)] instead of [get a n].
+
@raise Invalid_argument
- if [n] is outside the range 0 to [(Array.length a - 1)]. *)
+ if [n] is outside the range 0 to [(length a - 1)]. *)
external set : 'a array -> int -> 'a -> unit = "%array_safe_set"
-(** [Array.set a n x] modifies array [a] in place, replacing
+(** [set a n x] modifies array [a] in place, replacing
element number [n] with [x].
- You can also write [a.(n) <- x] instead of [Array.set a n x].
+ You can also write [a.(n) <- x] instead of [set a n x].
+
@raise Invalid_argument
- if [n] is outside the range 0 to [Array.length a - 1]. *)
+ if [n] is outside the range 0 to [length a - 1]. *)
external make : int -> 'a -> 'a array = "caml_make_vect"
-(** [Array.make n x] returns a fresh array of length [n],
+(** [make n x] returns a fresh array of length [n],
initialized with [x].
All the elements of this new array are initially
physically equal to [x] (in the sense of the [==] predicate).
Consequently, if [x] is mutable, it is shared among all elements
of the array, and modifying [x] through one of the array entries
will modify all other entries at the same time.
+
@raise Invalid_argument if [n < 0] or [n > Sys.max_array_length].
If the value of [x] is a floating-point number, then the maximum
size is only [Sys.max_array_length / 2].*)
external create : int -> 'a -> 'a array = "caml_make_vect"
- [@@ocaml.deprecated "Use Array.make instead."]
-(** @deprecated [Array.create] is an alias for {!Array.make}. *)
+ [@@ocaml.deprecated "Use Array.make/ArrayLabels.make instead."]
+(** @deprecated [create] is an alias for {!make}. *)
external create_float: int -> float array = "caml_make_float_vect"
-(** [Array.create_float n] returns a fresh float array of length [n],
+(** [create_float n] returns a fresh float array of length [n],
with uninitialized data.
@since 4.03 *)
val make_float: int -> float array
- [@@ocaml.deprecated "Use Array.create_float instead."]
-(** @deprecated [Array.make_float] is an alias for {!Array.create_float}. *)
+ [@@ocaml.deprecated
+ "Use Array.create_float/ArrayLabels.create_float instead."]
+(** @deprecated [make_float] is an alias for {!create_float}. *)
val init : int -> (int -> 'a) -> 'a array
-(** [Array.init n f] returns a fresh array of length [n],
+(** [init n f] returns a fresh array of length [n],
with element number [i] initialized to the result of [f i].
- In other terms, [Array.init n f] tabulates the results of [f]
+ In other terms, [init n f] tabulates the results of [f]
applied to the integers [0] to [n-1].
+
@raise Invalid_argument if [n < 0] or [n > Sys.max_array_length].
If the return type of [f] is [float], then the maximum
size is only [Sys.max_array_length / 2].*)
val make_matrix : int -> int -> 'a -> 'a array array
-(** [Array.make_matrix dimx dimy e] returns a two-dimensional array
+(** [make_matrix dimx dimy e] returns a two-dimensional array
(an array of arrays) with first dimension [dimx] and
second dimension [dimy]. All the elements of this new matrix
are initially physically equal to [e].
The element ([x,y]) of a matrix [m] is accessed
with the notation [m.(x).(y)].
+
@raise Invalid_argument if [dimx] or [dimy] is negative or
greater than {!Sys.max_array_length}.
If the value of [e] is a floating-point number, then the maximum
size is only [Sys.max_array_length / 2]. *)
val create_matrix : int -> int -> 'a -> 'a array array
- [@@ocaml.deprecated "Use Array.make_matrix instead."]
-(** @deprecated [Array.create_matrix] is an alias for {!Array.make_matrix}. *)
+ [@@ocaml.deprecated
+ "Use Array.make_matrix/ArrayLabels.make_matrix instead."]
+(** @deprecated [create_matrix] is an alias for {!make_matrix}. *)
val append : 'a array -> 'a array -> 'a array
-(** [Array.append v1 v2] returns a fresh array containing the
+(** [append v1 v2] returns a fresh array containing the
concatenation of the arrays [v1] and [v2].
@raise Invalid_argument if
- [Array.length v1 + Array.length v2 > Sys.max_array_length]. *)
+ [length v1 + length v2 > Sys.max_array_length]. *)
val concat : 'a array list -> 'a array
-(** Same as {!Array.append}, but concatenates a list of arrays. *)
+(** Same as {!append}, but concatenates a list of arrays. *)
val sub : 'a array -> int -> int -> 'a array
-(** [Array.sub a start len] returns a fresh array of length [len],
- containing the elements number [start] to [start + len - 1]
+(** [sub a pos len] returns a fresh array of length [len],
+ containing the elements number [pos] to [pos + len - 1]
of array [a].
- @raise Invalid_argument if [start] and [len] do not
+
+ @raise Invalid_argument if [pos] and [len] do not
designate a valid subarray of [a]; that is, if
- [start < 0], or [len < 0], or [start + len > Array.length a]. *)
+ [pos < 0], or [len < 0], or [pos + len > length a]. *)
val copy : 'a array -> 'a array
-(** [Array.copy a] returns a copy of [a], that is, a fresh array
+(** [copy a] returns a copy of [a], that is, a fresh array
containing the same elements as [a]. *)
val fill : 'a array -> int -> int -> 'a -> unit
-(** [Array.fill a ofs len x] modifies the array [a] in place,
- storing [x] in elements number [ofs] to [ofs + len - 1].
- @raise Invalid_argument if [ofs] and [len] do not
+(** [fill a pos len x] modifies the array [a] in place,
+ storing [x] in elements number [pos] to [pos + len - 1].
+
+ @raise Invalid_argument if [pos] and [len] do not
designate a valid subarray of [a]. *)
-val blit : 'a array -> int -> 'a array -> int -> int -> unit
-(** [Array.blit v1 o1 v2 o2 len] copies [len] elements
- from array [v1], starting at element number [o1], to array [v2],
- starting at element number [o2]. It works correctly even if
- [v1] and [v2] are the same array, and the source and
+val blit :
+ 'a array -> int -> 'a array -> int -> int ->
+ unit
+(** [blit src src_pos dst dst_pos len] copies [len] elements
+ from array [src], starting at element number [src_pos], to array [dst],
+ starting at element number [dst_pos]. It works correctly even if
+ [src] and [dst] are the same array, and the source and
destination chunks overlap.
- @raise Invalid_argument if [o1] and [len] do not
- designate a valid subarray of [v1], or if [o2] and [len] do not
- designate a valid subarray of [v2]. *)
+
+ @raise Invalid_argument if [src_pos] and [len] do not
+ designate a valid subarray of [src], or if [dst_pos] and [len] do not
+ designate a valid subarray of [dst]. *)
val to_list : 'a array -> 'a list
-(** [Array.to_list a] returns the list of all the elements of [a]. *)
+(** [to_list a] returns the list of all the elements of [a]. *)
val of_list : 'a list -> 'a array
-(** [Array.of_list l] returns a fresh array containing the elements
+(** [of_list l] returns a fresh array containing the elements
of [l].
- @raise Invalid_argument if the length of [l] is greater than
- [Sys.max_array_length].*)
+ @raise Invalid_argument if the length of [l] is greater than
+ [Sys.max_array_length]. *)
(** {1 Iterators} *)
-
val iter : ('a -> unit) -> 'a array -> unit
-(** [Array.iter f a] applies function [f] in turn to all
+(** [iter f a] applies function [f] in turn to all
the elements of [a]. It is equivalent to
- [f a.(0); f a.(1); ...; f a.(Array.length a - 1); ()]. *)
+ [f a.(0); f a.(1); ...; f a.(length a - 1); ()]. *)
val iteri : (int -> 'a -> unit) -> 'a array -> unit
-(** Same as {!Array.iter}, but the
- function is applied with the index of the element as first argument,
+(** Same as {!iter}, but the
+ function is applied to the index of the element as first argument,
and the element itself as second argument. *)
val map : ('a -> 'b) -> 'a array -> 'b array
-(** [Array.map f a] applies function [f] to all the elements of [a],
+(** [map f a] applies function [f] to all the elements of [a],
and builds an array with the results returned by [f]:
- [[| f a.(0); f a.(1); ...; f a.(Array.length a - 1) |]]. *)
+ [[| f a.(0); f a.(1); ...; f a.(length a - 1) |]]. *)
val mapi : (int -> 'a -> 'b) -> 'a array -> 'b array
-(** Same as {!Array.map}, but the
+(** Same as {!map}, but the
function is applied to the index of the element as first argument,
and the element itself as second argument. *)
val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b array -> 'a
-(** [Array.fold_left f x a] computes
- [f (... (f (f x a.(0)) a.(1)) ...) a.(n-1)],
+(** [fold_left f init a] computes
+ [f (... (f (f init a.(0)) a.(1)) ...) a.(n-1)],
where [n] is the length of the array [a]. *)
val fold_right : ('b -> 'a -> 'a) -> 'b array -> 'a -> 'a
-(** [Array.fold_right f a x] computes
- [f a.(0) (f a.(1) ( ... (f a.(n-1) x) ...))],
+(** [fold_right f a init] computes
+ [f a.(0) (f a.(1) ( ... (f a.(n-1) init) ...))],
where [n] is the length of the array [a]. *)
val iter2 : ('a -> 'b -> unit) -> 'a array -> 'b array -> unit
-(** [Array.iter2 f a b] applies function [f] to all the elements of [a]
+(** [iter2 f a b] applies function [f] to all the elements of [a]
and [b].
@raise Invalid_argument if the arrays are not the same size.
- @since 4.03.0 *)
+ @since 4.03.0 (4.05.0 in ArrayLabels)
+ *)
val map2 : ('a -> 'b -> 'c) -> 'a array -> 'b array -> 'c array
-(** [Array.map2 f a b] applies function [f] to all the elements of [a]
+(** [map2 f a b] applies function [f] to all the elements of [a]
and [b], and builds an array with the results returned by [f]:
- [[| f a.(0) b.(0); ...; f a.(Array.length a - 1) b.(Array.length b - 1)|]].
+ [[| f a.(0) b.(0); ...; f a.(length a - 1) b.(length b - 1)|]].
@raise Invalid_argument if the arrays are not the same size.
- @since 4.03.0 *)
+ @since 4.03.0 (4.05.0 in ArrayLabels) *)
(** {1 Array scanning} *)
-
val for_all : ('a -> bool) -> 'a array -> bool
-(** [Array.for_all p [|a1; ...; an|]] checks if all elements of the array
- satisfy the predicate [p]. That is, it returns
- [(p a1) && (p a2) && ... && (p an)].
+(** [for_all f [|a1; ...; an|]] checks if all elements
+ of the array satisfy the predicate [f]. That is, it returns
+ [(f a1) && (f a2) && ... && (f an)].
@since 4.03.0 *)
val exists : ('a -> bool) -> 'a array -> bool
-(** [Array.exists p [|a1; ...; an|]] checks if at least one element of
- the array satisfies the predicate [p]. That is, it returns
- [(p a1) || (p a2) || ... || (p an)].
+(** [exists f [|a1; ...; an|]] checks if at least one element of
+ the array satisfies the predicate [f]. That is, it returns
+ [(f a1) || (f a2) || ... || (f an)].
@since 4.03.0 *)
val for_all2 : ('a -> 'b -> bool) -> 'a array -> 'b array -> bool
-(** Same as {!Array.for_all}, but for a two-argument predicate.
+(** Same as {!for_all}, but for a two-argument predicate.
@raise Invalid_argument if the two arrays have different lengths.
@since 4.11.0 *)
val exists2 : ('a -> 'b -> bool) -> 'a array -> 'b array -> bool
-(** Same as {!Array.exists}, but for a two-argument predicate.
+(** Same as {!exists}, but for a two-argument predicate.
@raise Invalid_argument if the two arrays have different lengths.
@since 4.11.0 *)
val mem : 'a -> 'a array -> bool
-(** [mem a l] is true if and only if [a] is structurally equal
+(** [mem a set] is true if and only if [a] is structurally equal
to an element of [l] (i.e. there is an [x] in [l] such that
[compare a x = 0]).
@since 4.03.0 *)
val memq : 'a -> 'a array -> bool
-(** Same as {!Array.mem}, but uses physical equality instead of structural
- equality to compare elements.
+(** Same as {!mem}, but uses physical equality
+ instead of structural equality to compare list elements.
@since 4.03.0 *)
(** {1 Sorting} *)
-
val sort : ('a -> 'a -> int) -> 'a array -> unit
(** Sort an array in increasing order according to a comparison
function. The comparison function must return 0 if its arguments
compare as equal, a positive integer if the first is greater,
and a negative integer if the first is smaller (see below for a
complete specification). For example, {!Stdlib.compare} is
- a suitable comparison function. After calling [Array.sort], the
+ a suitable comparison function. After calling [sort], the
array is sorted in place in increasing order.
- [Array.sort] is guaranteed to run in constant heap space
+ [sort] is guaranteed to run in constant heap space
and (at most) logarithmic stack space.
The current implementation uses Heap Sort. It runs in constant
- [cmp x y] > 0 if and only if [cmp y x] < 0
- if [cmp x y] >= 0 and [cmp y z] >= 0 then [cmp x z] >= 0
- When [Array.sort] returns, [a] contains the same elements as before,
+ When [sort] returns, [a] contains the same elements as before,
reordered in such a way that for all i and j valid indices of [a] :
- [cmp a.(i) a.(j)] >= 0 if and only if i >= j
*)
val stable_sort : ('a -> 'a -> int) -> 'a array -> unit
-(** Same as {!Array.sort}, but the sorting algorithm is stable (i.e.
+(** Same as {!sort}, but the sorting algorithm is stable (i.e.
elements that compare equal are kept in their original order) and
not guaranteed to run in constant heap space.
- The current implementation uses Merge Sort. It uses a temporary
- array of length [n/2], where [n] is the length of the array.
- It is usually faster than the current implementation of {!Array.sort}.
+ The current implementation uses Merge Sort. It uses a temporary array of
+ length [n/2], where [n] is the length of the array. It is usually faster
+ than the current implementation of {!sort}.
*)
val fast_sort : ('a -> 'a -> int) -> 'a array -> unit
-(** Same as {!Array.sort} or {!Array.stable_sort}, whichever is faster
- on typical input.
-*)
+(** Same as {!sort} or {!stable_sort}, whichever is
+ faster on typical input. *)
(** {1 Iterators} *)
@since 4.07 *)
(**/**)
+
(** {1 Undocumented functions} *)
(* The following is for system use only. Do not call directly. *)
(* *)
(**************************************************************************)
-(** Array operations
+(* NOTE:
+ If this file is arrayLabels.mli, run tools/sync_stdlib_docs after editing it
+ to generate array.mli.
- This module is intended to be used via {!StdLabels} which replaces
- {!Array}, {!Bytes}, {!List} and {!String} with their labeled counterparts
+ If this file is array.mli, do not edit it directly -- edit
+ arrayLabels.mli instead.
+ *)
- For example:
- {[
- open StdLabels
+(** Array operations.
- let everything = Array.create_matrix ~dimx:42 ~dimy:42 42
- ]} *)
+ The labeled version of this module can be used as described in the
+ {!StdLabels} module.
+*)
type 'a t = 'a array
(** An alias for the type of arrays. *)
size is only [Sys.max_array_length / 2].*)
external create : int -> 'a -> 'a array = "caml_make_vect"
- [@@ocaml.deprecated "Use Array.make instead."]
+ [@@ocaml.deprecated "Use Array.make/ArrayLabels.make instead."]
(** @deprecated [create] is an alias for {!make}. *)
+external create_float: int -> float array = "caml_make_float_vect"
+(** [create_float n] returns a fresh float array of length [n],
+ with uninitialized data.
+ @since 4.03 *)
+
+val make_float: int -> float array
+ [@@ocaml.deprecated
+ "Use Array.create_float/ArrayLabels.create_float instead."]
+(** @deprecated [make_float] is an alias for {!create_float}. *)
+
val init : int -> f:(int -> 'a) -> 'a array
(** [init n ~f] returns a fresh array of length [n],
with element number [i] initialized to the result of [f i].
size is only [Sys.max_array_length / 2]. *)
val create_matrix : dimx:int -> dimy:int -> 'a -> 'a array array
- [@@ocaml.deprecated "Use Array.make_matrix instead."]
+ [@@ocaml.deprecated
+ "Use Array.make_matrix/ArrayLabels.make_matrix instead."]
(** @deprecated [create_matrix] is an alias for {!make_matrix}. *)
val append : 'a array -> 'a array -> 'a array
(** [append v1 v2] returns a fresh array containing the
- concatenation of the arrays [v1] and [v2]. *)
+ concatenation of the arrays [v1] and [v2].
+ @raise Invalid_argument if
+ [length v1 + length v2 > Sys.max_array_length]. *)
val concat : 'a array list -> 'a array
(** Same as {!append}, but concatenates a list of arrays. *)
val of_list : 'a list -> 'a array
(** [of_list l] returns a fresh array containing the elements
- of [l]. *)
+ of [l].
+
+ @raise Invalid_argument if the length of [l] is greater than
+ [Sys.max_array_length]. *)
+
+(** {1 Iterators} *)
val iter : f:('a -> unit) -> 'a array -> unit
(** [iter ~f a] applies function [f] in turn to all
the elements of [a]. It is equivalent to
[f a.(0); f a.(1); ...; f a.(length a - 1); ()]. *)
-val map : f:('a -> 'b) -> 'a array -> 'b array
-(** [map ~f a] applies function [f] to all the elements of [a],
- and builds an array with the results returned by [f]:
- [[| f a.(0); f a.(1); ...; f a.(length a - 1) |]]. *)
-
val iteri : f:(int -> 'a -> unit) -> 'a array -> unit
(** Same as {!iter}, but the
function is applied to the index of the element as first argument,
and the element itself as second argument. *)
+val map : f:('a -> 'b) -> 'a array -> 'b array
+(** [map ~f a] applies function [f] to all the elements of [a],
+ and builds an array with the results returned by [f]:
+ [[| f a.(0); f a.(1); ...; f a.(length a - 1) |]]. *)
+
val mapi : f:(int -> 'a -> 'b) -> 'a array -> 'b array
(** Same as {!map}, but the
function is applied to the index of the element as first argument,
(** [iter2 ~f a b] applies function [f] to all the elements of [a]
and [b].
@raise Invalid_argument if the arrays are not the same size.
- @since 4.05.0 *)
+ @since 4.03.0 (4.05.0 in ArrayLabels)
+ *)
val map2 : f:('a -> 'b -> 'c) -> 'a array -> 'b array -> 'c array
(** [map2 ~f a b] applies function [f] to all the elements of [a]
and [b], and builds an array with the results returned by [f]:
[[| f a.(0) b.(0); ...; f a.(length a - 1) b.(length b - 1)|]].
@raise Invalid_argument if the arrays are not the same size.
- @since 4.05.0 *)
+ @since 4.03.0 (4.05.0 in ArrayLabels) *)
(** {1 Array scanning} *)
+val for_all : f:('a -> bool) -> 'a array -> bool
+(** [for_all ~f [|a1; ...; an|]] checks if all elements
+ of the array satisfy the predicate [f]. That is, it returns
+ [(f a1) && (f a2) && ... && (f an)].
+ @since 4.03.0 *)
val exists : f:('a -> bool) -> 'a array -> bool
(** [exists ~f [|a1; ...; an|]] checks if at least one element of
[(f a1) || (f a2) || ... || (f an)].
@since 4.03.0 *)
-val for_all : f:('a -> bool) -> 'a array -> bool
-(** [for_all ~f [|a1; ...; an|]] checks if all elements
- of the array satisfy the predicate [f]. That is, it returns
- [(f a1) && (f a2) && ... && (f an)].
- @since 4.03.0 *)
-
val for_all2 : f:('a -> 'b -> bool) -> 'a array -> 'b array -> bool
-(** Same as {!ArrayLabels.for_all}, but for a two-argument predicate.
+(** Same as {!for_all}, but for a two-argument predicate.
@raise Invalid_argument if the two arrays have different lengths.
@since 4.11.0 *)
val exists2 : f:('a -> 'b -> bool) -> 'a array -> 'b array -> bool
-(** Same as {!ArrayLabels.exists}, but for a two-argument predicate.
+(** Same as {!exists}, but for a two-argument predicate.
@raise Invalid_argument if the two arrays have different lengths.
@since 4.11.0 *)
val mem : 'a -> set:'a array -> bool
-(** [mem x ~set] is true if and only if [x] is equal
- to an element of [set].
- @since 4.03.0 *)
+(** [mem a ~set] is true if and only if [a] is structurally equal
+ to an element of [l] (i.e. there is an [x] in [l] such that
+ [compare a x = 0]).
+ @since 4.03.0 *)
val memq : 'a -> set:'a array -> bool
(** Same as {!mem}, but uses physical equality
instead of structural equality to compare list elements.
@since 4.03.0 *)
-external create_float: int -> float array = "caml_make_float_vect"
-(** [create_float n] returns a fresh float array of length [n],
- with uninitialized data.
- @since 4.03 *)
-
-val make_float: int -> float array
- [@@ocaml.deprecated "Use Array.create_float instead."]
-(** @deprecated {!make_float} is an alias for
- {!create_float}. *)
-
(** {1 Sorting} *)
-
val sort : cmp:('a -> 'a -> int) -> 'a array -> unit
(** Sort an array in increasing order according to a comparison
function. The comparison function must return 0 if its arguments
compare as equal, a positive integer if the first is greater,
and a negative integer if the first is smaller (see below for a
complete specification). For example, {!Stdlib.compare} is
- a suitable comparison function, provided there are no floating-point
- NaN values in the data. After calling [sort], the
+ a suitable comparison function. After calling [sort], the
array is sorted in place in increasing order.
[sort] is guaranteed to run in constant heap space
and (at most) logarithmic stack space.
Specification of the comparison function:
Let [a] be the array and [cmp] the comparison function. The following
- must be true for all x, y, z in a :
+ must be true for all [x], [y], [z] in [a] :
- [cmp x y] > 0 if and only if [cmp y x] < 0
- if [cmp x y] >= 0 and [cmp y z] >= 0 then [cmp x z] >= 0
elements that compare equal are kept in their original order) and
not guaranteed to run in constant heap space.
- The current implementation uses Merge Sort. It uses [n/2]
- words of heap space, where [n] is the length of the array.
- It is usually faster than the current implementation of {!sort}.
+ The current implementation uses Merge Sort. It uses a temporary array of
+ length [n/2], where [n] is the length of the array. It is usually faster
+ than the current implementation of {!sort}.
*)
val fast_sort : cmp:('a -> 'a -> int) -> 'a array -> unit
-(** Same as {!sort} or {!stable_sort}, whichever is faster on typical input. *)
+(** Same as {!sort} or {!stable_sort}, whichever is
+ faster on typical input. *)
(** {1 Iterators} *)
val to_seq : 'a array -> 'a Seq.t
-(** Iterate on the array, in increasing order
+(** Iterate on the array, in increasing order. Modifications of the
+ array during iteration will be reflected in the iterator.
@since 4.07 *)
val to_seqi : 'a array -> (int * 'a) Seq.t
-(** Iterate on the array, in increasing order, yielding indices along elements
+(** Iterate on the array, in increasing order, yielding indices along elements.
+ Modifications of the array during iteration will be reflected in the
+ iterator.
@since 4.07 *)
val of_seq : 'a Seq.t -> 'a array
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Guillaume Munch-Maccagnoni, projet Gallinette, INRIA *)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+include CamlinternalAtomic
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Stephen Dolan, University of Cambridge *)
+(* Gabriel Scherer, projet Partout, INRIA Paris-Saclay *)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(** This module provides a purely sequential implementation of the
+ concurrent atomic references provided by the Multicore OCaml
+ standard library:
+
+ https://github.com/ocaml-multicore/ocaml-multicore/blob/parallel_minor_gc/stdlib/atomic.mli
+
+ This sequential implementation is provided in the interest of
+ 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. *)
+
+(** An atomic (mutable) reference to a value of type ['a]. *)
+type !'a t
+
+(** Create an atomic reference. *)
+val make : 'a -> 'a t
+
+(** Get the current value of the atomic reference. *)
+val get : 'a t -> 'a
+
+(** Set a new value for the atomic reference. *)
+val set : 'a t -> 'a -> unit
+
+(** Set a new value for the atomic reference, and return the current value. *)
+val exchange : 'a t -> 'a -> 'a
+
+(** [compare_and_set r seen v] sets the new value of [r] to [v] only
+ if its current value is physically equal to [seen] -- the
+ comparison and the set occur atomically. Returns [true] if the
+ comparison succeeded (so the set happened) and [false]
+ otherwise. *)
+val compare_and_set : 'a t -> 'a -> 'a -> bool
+
+(** [fetch_and_add r n] atomically increments the value of [r] by [n],
+ and returns the current value (before the increment). *)
+val fetch_and_add : int t -> int -> int
+
+(** [incr r] atomically increments the value of [r] by [1]. *)
+val incr : int t -> unit
+
+(** [decr r] atomically decrements the value of [r] by [1]. *)
+val decr : int t -> unit
let fortran_layout = Fortran_layout
module Genarray = struct
- type ('a, 'b, 'c) t
+ type (!'a, !'b, !'c) t
external create: ('a, 'b) kind -> 'c layout -> int array -> ('a, 'b, 'c) t
= "caml_ba_create"
external get: ('a, 'b, 'c) t -> int array -> 'a
= "caml_ba_get_generic"
external set: ('a, 'b, 'c) t -> int array -> 'a -> unit
= "caml_ba_set_generic"
+
+ let rec cloop arr idx f col max =
+ if col = Array.length idx then set arr idx (f idx)
+ else for j = 0 to pred max.(col) do
+ idx.(col) <- j;
+ cloop arr idx f (succ col) max
+ done
+ let rec floop arr idx f col max =
+ if col < 0 then set arr idx (f idx)
+ else for j = 1 to max.(col) do
+ idx.(col) <- j;
+ floop arr idx f (pred col) max
+ done
+ let init (type t) kind (layout : t layout) dims f =
+ let arr = create kind layout dims in
+ match Array.length dims, layout with
+ | 0, _ -> arr
+ | dlen, C_layout -> cloop arr (Array.make dlen 0) f 0 dims; arr
+ | dlen, Fortran_layout -> floop arr (Array.make dlen 1) f (pred dlen) dims;
+ arr
+
external num_dims: ('a, 'b, 'c) t -> int = "caml_ba_num_dims"
external nth_dim: ('a, 'b, 'c) t -> int -> int = "caml_ba_dim"
let dims a =
end
module Array0 = struct
- type ('a, 'b, 'c) t = ('a, 'b, 'c) Genarray.t
+ type (!'a, !'b, !'c) t = ('a, 'b, 'c) Genarray.t
let create kind layout =
Genarray.create kind layout [||]
let get arr = Genarray.get arr [||]
let a = create kind layout in
set a v;
a
+ let init = of_value
end
module Array1 = struct
- type ('a, 'b, 'c) t = ('a, 'b, 'c) Genarray.t
+ type (!'a, !'b, !'c) t = ('a, 'b, 'c) Genarray.t
let create kind layout dim =
Genarray.create kind layout [|dim|]
external get: ('a, 'b, 'c) t -> int -> 'a = "%caml_ba_ref_1"
| Fortran_layout -> (Genarray.slice_right a [|n|]: (_, _, t) Genarray.t)
external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit"
external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
+ let c_init arr dim f =
+ for i = 0 to pred dim do unsafe_set arr i (f i) done
+ let fortran_init arr dim f =
+ for i = 1 to dim do unsafe_set arr i (f i) done
+ let init (type t) kind (layout : t layout) dim f =
+ let arr = create kind layout dim in
+ match layout with
+ | C_layout -> c_init arr dim f; arr
+ | Fortran_layout -> fortran_init arr dim f; arr
let of_array (type t) kind (layout: t layout) data =
let ba = create kind layout (Array.length data) in
let ofs =
end
module Array2 = struct
- type ('a, 'b, 'c) t = ('a, 'b, 'c) Genarray.t
+ type (!'a, !'b, !'c) t = ('a, 'b, 'c) Genarray.t
let create kind layout dim1 dim2 =
Genarray.create kind layout [|dim1; dim2|]
external get: ('a, 'b, 'c) t -> int -> int -> 'a = "%caml_ba_ref_2"
let slice_right a n = Genarray.slice_right a [|n|]
external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit"
external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
+ let c_init arr dim1 dim2 f =
+ for i = 0 to pred dim1 do
+ for j = 0 to pred dim2 do
+ unsafe_set arr i j (f i j)
+ done
+ done
+ let fortran_init arr dim1 dim2 f =
+ for j = 1 to dim2 do
+ for i = 1 to dim1 do
+ unsafe_set arr i j (f i j)
+ done
+ done
+ let init (type t) kind (layout : t layout) dim1 dim2 f =
+ let arr = create kind layout dim1 dim2 in
+ match layout with
+ | C_layout -> c_init arr dim1 dim2 f; arr
+ | Fortran_layout -> fortran_init arr dim1 dim2 f; arr
let of_array (type t) kind (layout: t layout) data =
let dim1 = Array.length data in
let dim2 = if dim1 = 0 then 0 else Array.length data.(0) in
end
module Array3 = struct
- type ('a, 'b, 'c) t = ('a, 'b, 'c) Genarray.t
+ type (!'a, !'b, !'c) t = ('a, 'b, 'c) Genarray.t
let create kind layout dim1 dim2 dim3 =
Genarray.create kind layout [|dim1; dim2; dim3|]
external get: ('a, 'b, 'c) t -> int -> int -> int -> 'a = "%caml_ba_ref_3"
let slice_right_2 a n = Genarray.slice_right a [|n|]
external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit"
external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
+ let c_init arr dim1 dim2 dim3 f =
+ for i = 0 to pred dim1 do
+ for j = 0 to pred dim2 do
+ for k = 0 to pred dim3 do
+ unsafe_set arr i j k (f i j k)
+ done
+ done
+ done
+ let fortran_init arr dim1 dim2 dim3 f =
+ for k = 1 to dim3 do
+ for j = 1 to dim2 do
+ for i = 1 to dim1 do
+ unsafe_set arr i j k (f i j k)
+ done
+ done
+ done
+ let init (type t) kind (layout : t layout) dim1 dim2 dim3 f =
+ let arr = create kind layout dim1 dim2 dim3 in
+ match layout with
+ | C_layout -> c_init arr dim1 dim2 dim3 f; arr
+ | Fortran_layout -> fortran_init arr dim1 dim2 dim3 f; arr
let of_array (type t) kind (layout: t layout) data =
let dim1 = Array.length data in
let dim2 = if dim1 = 0 then 0 else Array.length data.(0) in
module Genarray :
sig
- type ('a, 'b, 'c) t
+ type (!'a, !'b, !'c) t
(** The type [Genarray.t] is the type of Bigarrays with variable
numbers of dimensions. Any number of dimensions between 0 and 16
is supported.
is not in the range 0 to 16 inclusive, or if one of the dimensions
is negative. *)
+ val init: ('a, 'b) kind -> 'c layout -> int array -> (int array -> 'a) ->
+ ('a, 'b, 'c) t
+ (** [Genarray.init kind layout dimensions f] returns a new Bigarray [b]
+ whose element kind is determined by the parameter [kind] (one of
+ [float32], [float64], [int8_signed], etc) and whose layout is
+ determined by the parameter [layout] (one of [c_layout] or
+ [fortran_layout]). The [dimensions] parameter is an array of
+ integers that indicate the size of the Bigarray in each dimension.
+ The length of [dimensions] determines the number of dimensions
+ of the Bigarray.
+
+ Each element [Genarray.get b i] is initialized to the result of [f i].
+ In other words, [Genarray.init kind layout dimensions f] tabulates
+ the results of [f] applied to the indices of a new Bigarray whose
+ layout is described by [kind], [layout] and [dimensions]. The index
+ array [i] may be shared and mutated between calls to f.
+
+ For instance, [Genarray.init int c_layout [|2; 1; 3|]
+ (Array.fold_left (+) 0)] returns a fresh Bigarray of integers, in C
+ layout, having three dimensions (2, 1, 3, respectively), with the
+ element values 0, 1, 2, 1, 2, 3.
+
+ [Genarray.init] raises [Invalid_argument] if the number of dimensions
+ is not in the range 0 to 16 inclusive, or if one of the dimensions
+ is negative.
+
+ @since 4.12.0 *)
+
external num_dims: ('a, 'b, 'c) t -> int = "caml_ba_num_dims"
(** Return the number of dimensions of the given Bigarray. *)
faster operations, and more precise static type-checking.
@since 4.05.0 *)
module Array0 : sig
- type ('a, 'b, 'c) t
+ type (!'a, !'b, !'c) t
(** The type of zero-dimensional Bigarrays whose elements have
OCaml type ['a], representation kind ['b], and memory layout ['c]. *)
[kind] and [layout] determine the array element kind and the array
layout as described for {!Genarray.create}. *)
+ val init: ('a, 'b) kind -> 'c layout -> 'a -> ('a, 'b, 'c) t
+ (** [Array0.init kind layout v] behaves like [Array0.create kind layout]
+ except that the element is additionally initialized to the value [v].
+
+ @since 4.12.0 *)
+
external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
(** Return the kind of the given Bigarray. *)
Statically knowing the number of dimensions of the array allows
faster operations, and more precise static type-checking. *)
module Array1 : sig
- type ('a, 'b, 'c) t
+ type (!'a, !'b, !'c) t
(** The type of one-dimensional Bigarrays whose elements have
OCaml type ['a], representation kind ['b], and memory layout ['c]. *)
determine the array element kind and the array layout
as described for {!Genarray.create}. *)
+ val init: ('a, 'b) kind -> 'c layout -> int -> (int -> 'a) ->
+ ('a, 'b, 'c) t
+ (** [Array1.init kind layout dim f] returns a new Bigarray [b]
+ of one dimension, whose size is [dim]. [kind] and [layout]
+ determine the array element kind and the array layout
+ as described for {!Genarray.create}.
+
+ Each element [Array1.get b i] of the array is initialized to the
+ result of [f i].
+
+ In other words, [Array1.init kind layout dimensions f] tabulates
+ the results of [f] applied to the indices of a new Bigarray whose
+ layout is described by [kind], [layout] and [dim].
+
+ @since 4.12.0 *)
+
external dim: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1"
(** Return the size (dimension) of the given one-dimensional
Bigarray. *)
case of two-dimensional arrays. *)
module Array2 :
sig
- type ('a, 'b, 'c) t
+ type (!'a, !'b, !'c) t
(** The type of two-dimensional Bigarrays whose elements have
OCaml type ['a], representation kind ['b], and memory layout ['c]. *)
val create: ('a, 'b) kind -> 'c layout -> int -> int -> ('a, 'b, 'c) t
(** [Array2.create kind layout dim1 dim2] returns a new Bigarray of
- two dimension, whose size is [dim1] in the first dimension
+ two dimensions, whose size is [dim1] in the first dimension
and [dim2] in the second dimension. [kind] and [layout]
determine the array element kind and the array layout
as described for {!Bigarray.Genarray.create}. *)
+ val init: ('a, 'b) kind -> 'c layout -> int -> int ->
+ (int -> int -> 'a) -> ('a, 'b, 'c) t
+ (** [Array2.init kind layout dim1 dim2 f] returns a new Bigarray [b]
+ of two dimensions, whose size is [dim2] in the first dimension
+ and [dim2] in the second dimension. [kind] and [layout]
+ determine the array element kind and the array layout
+ as described for {!Bigarray.Genarray.create}.
+
+ Each element [Array2.get b i j] of the array is initialized to
+ the result of [f i j].
+
+ In other words, [Array2.init kind layout dim1 dim2 f] tabulates
+ the results of [f] applied to the indices of a new Bigarray whose
+ layout is described by [kind], [layout], [dim1] and [dim2].
+
+ @since 4.12.0 *)
+
external dim1: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1"
(** Return the first dimension of the given two-dimensional Bigarray. *)
of three-dimensional arrays. *)
module Array3 :
sig
- type ('a, 'b, 'c) t
+ type (!'a, !'b, !'c) t
(** The type of three-dimensional Bigarrays whose elements have
OCaml type ['a], representation kind ['b], and memory layout ['c]. *)
val create: ('a, 'b) kind -> 'c layout -> int -> int -> int -> ('a, 'b, 'c) t
(** [Array3.create kind layout dim1 dim2 dim3] returns a new Bigarray of
- three dimension, whose size is [dim1] in the first dimension,
+ three dimensions, whose size is [dim1] in the first dimension,
[dim2] in the second dimension, and [dim3] in the third.
[kind] and [layout] determine the array element kind and
the array layout as described for {!Bigarray.Genarray.create}. *)
+ val init: ('a, 'b) kind -> 'c layout -> int -> int -> int ->
+ (int -> int -> int -> 'a) -> ('a, 'b, 'c) t
+ (** [Array3.init kind layout dim1 dim2 dim3 f] returns a new Bigarray [b]
+ of three dimensions, whose size is [dim1] in the first dimension,
+ [dim2] in the second dimension, and [dim3] in the third.
+ [kind] and [layout] determine the array element kind and the array
+ layout as described for {!Bigarray.Genarray.create}.
+
+ Each element [Array3.get b i j k] of the array is initialized to
+ the result of [f i j k].
+
+ In other words, [Array3.init kind layout dim1 dim2 dim3 f] tabulates
+ the results of [f] applied to the indices of a new Bigarray whose
+ layout is described by [kind], [layout], [dim1], [dim2] and [dim3].
+
+ @since 4.12.0 *)
+
external dim1: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1"
(** Return the first dimension of the given three-dimensional Bigarray. *)
(** {1:preds Predicates and comparisons} *)
val equal : bool -> bool -> bool
-(** [equal b0 b1] is [true] iff [b0] and [b1] are both either [true]
- or [false]. *)
+(** [equal b0 b1] is [true] if and only if [b0] and [b1] are both [true]
+ or both [false]. *)
val compare : bool -> bool -> int
(** [compare b0 b1] is a total order on boolean values. [false] is smaller
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
- concatenated pairwise).
+ concatenated pairwise). For example:
+
+{[
+ let concat_strings ss =
+ let b = Buffer.create 16 in
+ List.iter (Buffer.add_string b) ss;
+ Buffer.contents b
+
+]}
+
*)
type t
(* *)
(**************************************************************************)
+(* NOTE:
+ If this file is bytesLabels.mli, run tools/sync_stdlib_docs after editing it
+ to generate bytes.mli.
+
+ If this file is bytes.mli, do not edit it directly -- edit
+ bytesLabels.mli instead.
+ *)
+
(** Byte sequence operations.
A byte sequence is a mutable data structure that contains a
Bytes are represented by the OCaml type [char].
+ The labeled version of this module can be used as described in the
+ {!StdLabels} module.
+
@since 4.02.0
- *)
+
+ *)
external length : bytes -> int = "%bytes_length"
(** Return the length (number of bytes) of the argument. *)
(** [get s n] returns the byte at index [n] in argument [s].
@raise Invalid_argument if [n] is not a valid index in [s]. *)
+
external set : bytes -> int -> char -> unit = "%bytes_safe_set"
(** [set s n c] modifies [s] in place, replacing the byte at index [n]
with [c].
@raise Invalid_argument if [n < 0] or [n > ]{!Sys.max_string_length}. *)
val init : int -> (int -> char) -> bytes
-(** [Bytes.init n f] returns a fresh byte sequence of length [n], with
- character [i] initialized to the result of [f i] (in increasing
+(** [init n f] returns a fresh byte sequence of length [n],
+ with character [i] initialized to the result of [f i] (in increasing
index order).
@raise Invalid_argument if [n < 0] or [n > ]{!Sys.max_string_length}. *)
sequence. *)
val sub : bytes -> int -> int -> bytes
-(** [sub s start len] returns a new byte sequence of length [len],
- containing the subsequence of [s] that starts at position [start]
+(** [sub s pos len] returns a new byte sequence of length [len],
+ containing the subsequence of [s] that starts at position [pos]
and has length [len].
- @raise Invalid_argument if [start] and [len] do not designate a
+ @raise Invalid_argument if [pos] and [len] do not designate a
valid range of [s]. *)
val sub_string : bytes -> int -> int -> string
-(** Same as [sub] but return a string instead of a byte sequence. *)
+(** Same as {!sub} but return a string instead of a byte sequence. *)
val extend : bytes -> int -> int -> bytes
(** [extend s left right] returns a new byte sequence that contains
is negative, then bytes are removed (instead of appended) from
the corresponding side of [s].
@raise Invalid_argument if the result length is negative or
- longer than {!Sys.max_string_length} bytes. *)
+ longer than {!Sys.max_string_length} bytes.
+ @since 4.05.0 in BytesLabels *)
val fill : bytes -> int -> int -> char -> unit
-(** [fill s start len c] modifies [s] in place, replacing [len]
- characters with [c], starting at [start].
- @raise Invalid_argument if [start] and [len] do not designate a
+(** [fill s pos len c] modifies [s] in place, replacing [len]
+ characters with [c], starting at [pos].
+ @raise Invalid_argument if [pos] and [len] do not designate a
valid range of [s]. *)
-val blit : bytes -> int -> bytes -> int -> int -> unit
-(** [blit src srcoff dst dstoff len] copies [len] bytes from sequence
- [src], starting at index [srcoff], to sequence [dst], starting at
- index [dstoff]. It works correctly even if [src] and [dst] are the
+val blit :
+ bytes -> int -> bytes -> int -> int
+ -> unit
+(** [blit src src_pos dst dst_pos len] copies [len] bytes from sequence
+ [src], starting at index [src_pos], to sequence [dst], starting at
+ index [dst_pos]. It works correctly even if [src] and [dst] are the
same byte sequence, and the source and destination intervals
overlap.
- @raise Invalid_argument if [srcoff] and [len] do not
- designate a valid range of [src], or if [dstoff] and [len]
+ @raise Invalid_argument if [src_pos] and [len] do not
+ designate a valid range of [src], or if [dst_pos] and [len]
do not designate a valid range of [dst]. *)
-val blit_string : string -> int -> bytes -> int -> int -> unit
-(** [blit_string src srcoff dst dstoff len] copies [len] bytes from
- string [src], starting at index [srcoff], to byte sequence [dst],
- starting at index [dstoff].
- @raise Invalid_argument if [srcoff] and [len] do not
- designate a valid range of [src], or if [dstoff] and [len]
- do not designate a valid range of [dst]. *)
+val blit_string :
+ string -> int -> bytes -> int -> int
+ -> unit
+(** [blit src src_pos dst dst_pos len] copies [len] bytes from string
+ [src], starting at index [src_pos], to byte sequence [dst],
+ starting at index [dst_pos].
+ @raise Invalid_argument if [src_pos] and [len] do not
+ designate a valid range of [src], or if [dst_pos] and [len]
+ do not designate a valid range of [dst].
+ @since 4.05.0 in BytesLabels *)
val concat : bytes -> bytes list -> bytes
(** [concat sep sl] concatenates the list of byte sequences [sl],
inserting the separator byte sequence [sep] between each, and
returns the result as a new byte sequence.
@raise Invalid_argument if the result is longer than
- {!Sys.max_string_length} bytes. *)
+ {!Sys.max_string_length} bytes.
+ *)
val cat : bytes -> bytes -> bytes
(** [cat s1 s2] concatenates [s1] and [s2] and returns the result
as a new byte sequence.
@raise Invalid_argument if the result is longer than
- {!Sys.max_string_length} bytes. *)
+ {!Sys.max_string_length} bytes.
+ @since 4.05.0 in BytesLabels *)
val iter : (char -> unit) -> bytes -> unit
(** [iter f s] applies function [f] in turn to all the bytes of [s].
(length s - 1)); ()]. *)
val iteri : (int -> char -> unit) -> bytes -> unit
-(** Same as {!Bytes.iter}, but the function is applied to the index of
+(** Same as {!iter}, but the function is applied to the index of
the byte as first argument and the byte itself as second
argument. *)
val map : (char -> char) -> bytes -> bytes
-(** [map f s] applies function [f] in turn to all the bytes of [s]
- (in increasing index order) and stores the resulting bytes in
- a new sequence that is returned as the result. *)
+(** [map f s] applies function [f] in turn to all the bytes of [s] (in
+ increasing index order) and stores the resulting bytes in a new sequence
+ that is returned as the result. *)
val mapi : (int -> char -> char) -> bytes -> bytes
(** [mapi f s] calls [f] with each character of [s] and its
val index_from : bytes -> int -> char -> int
(** [index_from s i c] returns the index of the first occurrence of
- byte [c] in [s] after position [i]. [Bytes.index s c] is
- equivalent to [Bytes.index_from s 0 c].
+ byte [c] in [s] after position [i]. [index s c] is
+ equivalent to [index_from s 0 c].
@raise Invalid_argument if [i] is not a valid position in [s].
@raise Not_found if [c] does not occur in [s] after position [i]. *)
(** [index_from_opt s i c] returns the index of the first occurrence of
byte [c] in [s] after position [i] or [None] if [c] does not occur in [s]
after position [i].
- [Bytes.index_opt s c] is equivalent to [Bytes.index_from_opt s 0 c].
+ [index_opt s c] is equivalent to [index_from_opt s 0 c].
@raise Invalid_argument if [i] is not a valid position in [s].
@since 4.05 *)
val rindex_from : bytes -> int -> char -> int
(** [rindex_from s i c] returns the index of the last occurrence of
byte [c] in [s] before position [i+1]. [rindex s c] is equivalent
- to [rindex_from s (Bytes.length s - 1) c].
+ to [rindex_from s (length s - 1) c].
@raise Invalid_argument if [i+1] is not a valid position in [s].
@raise Not_found if [c] does not occur in [s] before position [i+1]. *)
(** [rindex_from_opt s i c] returns the index of the last occurrence
of byte [c] in [s] before position [i+1] or [None] if [c] does not
occur in [s] before position [i+1]. [rindex_opt s c] is equivalent to
- [rindex_from s (Bytes.length s - 1) c].
+ [rindex_from s (length s - 1) c].
@raise Invalid_argument if [i+1] is not a valid position in [s].
@since 4.05 *)
position in [s]. *)
val uppercase : bytes -> bytes
- [@@ocaml.deprecated "Use Bytes.uppercase_ascii instead."]
+ [@@ocaml.deprecated
+ "Use Bytes.uppercase_ascii/BytesLabels.uppercase_ascii instead."]
(** Return a copy of the argument, with all lowercase letters
translated to uppercase, including accented letters of the ISO
Latin-1 (8859-1) character set.
@deprecated Functions operating on Latin-1 character set are deprecated. *)
val lowercase : bytes -> bytes
- [@@ocaml.deprecated "Use Bytes.lowercase_ascii instead."]
+ [@@ocaml.deprecated
+ "Use Bytes.lowercase_ascii/BytesLabels.lowercase_ascii instead."]
(** Return a copy of the argument, with all uppercase letters
translated to lowercase, including accented letters of the ISO
Latin-1 (8859-1) character set.
@deprecated Functions operating on Latin-1 character set are deprecated. *)
val capitalize : bytes -> bytes
- [@@ocaml.deprecated "Use Bytes.capitalize_ascii instead."]
+ [@@ocaml.deprecated
+ "Use Bytes.capitalize_ascii/BytesLabels.capitalize_ascii instead."]
(** Return a copy of the argument, with the first character set to uppercase,
- using the ISO Latin-1 (8859-1) character set..
+ using the ISO Latin-1 (8859-1) character set.
@deprecated Functions operating on Latin-1 character set are deprecated. *)
val uncapitalize : bytes -> bytes
- [@@ocaml.deprecated "Use Bytes.uncapitalize_ascii instead."]
+ [@@ocaml.deprecated
+ "Use Bytes.uncapitalize_ascii/BytesLabels.uncapitalize_ascii instead."]
(** Return a copy of the argument, with the first character set to lowercase,
- using the ISO Latin-1 (8859-1) character set..
+ using the ISO Latin-1 (8859-1) character set.
@deprecated Functions operating on Latin-1 character set are deprecated. *)
val uppercase_ascii : bytes -> bytes
(** Return a copy of the argument, with all lowercase letters
translated to uppercase, using the US-ASCII character set.
- @since 4.03.0 *)
+ @since 4.03.0 (4.05.0 in BytesLabels) *)
val lowercase_ascii : bytes -> bytes
(** Return a copy of the argument, with all uppercase letters
translated to lowercase, using the US-ASCII character set.
- @since 4.03.0 *)
+ @since 4.03.0 (4.05.0 in BytesLabels) *)
val capitalize_ascii : bytes -> bytes
(** Return a copy of the argument, with the first character set to uppercase,
using the US-ASCII character set.
- @since 4.03.0 *)
+ @since 4.03.0 (4.05.0 in BytesLabels) *)
val uncapitalize_ascii : bytes -> bytes
(** Return a copy of the argument, with the first character set to lowercase,
using the US-ASCII character set.
- @since 4.03.0 *)
+ @since 4.03.0 (4.05.0 in BytesLabels) *)
type t = bytes
(** An alias for the type of byte sequences. *)
val equal: t -> t -> bool
(** The equality function for byte sequences.
- @since 4.03.0 *)
+ @since 4.03.0 (4.05.0 in BytesLabels) *)
(** {1:unsafe Unsafe conversions (for advanced users)}
used improperly, they can break the immutability invariant on
strings provided by the [-safe-string] option. They are available for
expert library authors, but for most purposes you should use the
- always-correct {!Bytes.to_string} and {!Bytes.of_string} instead.
+ always-correct {!to_string} and {!of_string} instead.
*)
val unsafe_to_string : bytes -> string
[string] type for this purpose.
*)
+
(** {1 Iterators} *)
val to_seq : t -> char Seq.t
*)
-
(**/**)
(* The following is for system use only. Do not call directly. *)
external unsafe_get : bytes -> int -> char = "%bytes_unsafe_get"
external unsafe_set : bytes -> int -> char -> unit = "%bytes_unsafe_set"
external unsafe_blit :
- bytes -> int -> bytes -> int -> int -> unit
- = "caml_blit_bytes" [@@noalloc]
+ bytes -> int -> bytes -> int -> int ->
+ unit = "caml_blit_bytes" [@@noalloc]
external unsafe_blit_string :
string -> int -> bytes -> int -> int -> unit
= "caml_blit_string" [@@noalloc]
(* *)
(**************************************************************************)
+(* NOTE:
+ If this file is bytesLabels.mli, run tools/sync_stdlib_docs after editing it
+ to generate bytes.mli.
+
+ If this file is bytes.mli, do not edit it directly -- edit
+ bytesLabels.mli instead.
+ *)
+
(** Byte sequence operations.
- @since 4.02.0
- This module is intended to be used through {!StdLabels} which replaces
- {!Array}, {!Bytes}, {!List} and {!String} with their labeled counterparts.
+ A byte sequence is a mutable data structure that contains a
+ fixed-length sequence of bytes. Each byte can be indexed in
+ constant time for reading or writing.
- For example:
- {[
- open StdLabels
+ Given a byte sequence [s] of length [l], we can access each of the
+ [l] bytes of [s] via its index in the sequence. Indexes start at
+ [0], and we will call an index valid in [s] if it falls within the
+ range [[0...l-1]] (inclusive). A position is the point between two
+ bytes or at the beginning or end of the sequence. We call a
+ position valid in [s] if it falls within the range [[0...l]]
+ (inclusive). Note that the byte at index [n] is between positions
+ [n] and [n+1].
+
+ Two parameters [start] and [len] are said to designate a valid
+ range of [s] if [len >= 0] and [start] and [start+len] are valid
+ positions in [s].
+
+ Byte sequences can be modified in place, for instance via the [set]
+ and [blit] functions described below. See also strings (module
+ {!String}), which are almost the same data structure, but cannot be
+ modified in place.
+
+ Bytes are represented by the OCaml type [char].
+
+ The labeled version of this module can be used as described in the
+ {!StdLabels} module.
- let first = Bytes.sub ~pos:0 ~len:1
- ]} *)
+ @since 4.02.0
+
+ *)
external length : bytes -> int = "%bytes_length"
(** Return the length (number of bytes) of the argument. *)
val init : int -> f:(int -> char) -> bytes
(** [init n f] returns a fresh byte sequence of length [n],
- with character [i] initialized to the result of [f i].
+ with character [i] initialized to the result of [f i] (in increasing
+ index order).
@raise Invalid_argument if [n < 0] or [n > ]{!Sys.max_string_length}. *)
val empty : bytes
sequence. *)
val sub : bytes -> pos:int -> len:int -> bytes
-(** [sub s start len] returns a new byte sequence of length [len],
- containing the subsequence of [s] that starts at position [start]
+(** [sub s ~pos ~len] returns a new byte sequence of length [len],
+ containing the subsequence of [s] that starts at position [pos]
and has length [len].
- @raise Invalid_argument if [start] and [len] do not designate a
+ @raise Invalid_argument if [pos] and [len] do not designate a
valid range of [s]. *)
val sub_string : bytes -> pos:int -> len:int -> string
-(** Same as [sub] but return a string instead of a byte sequence. *)
+(** Same as {!sub} but return a string instead of a byte sequence. *)
val extend : bytes -> left:int -> right:int -> bytes
-(** [extend s left right] returns a new byte sequence that contains
+(** [extend s ~left ~right] returns a new byte sequence that contains
the bytes of [s], with [left] uninitialized bytes prepended and
[right] uninitialized bytes appended to it. If [left] or [right]
is negative, then bytes are removed (instead of appended) from
the corresponding side of [s].
@raise Invalid_argument if the result length is negative or
longer than {!Sys.max_string_length} bytes.
- @since 4.05.0 *)
+ @since 4.05.0 in BytesLabels *)
val fill : bytes -> pos:int -> len:int -> char -> unit
-(** [fill s start len c] modifies [s] in place, replacing [len]
- characters with [c], starting at [start].
- @raise Invalid_argument if [start] and [len] do not designate a
+(** [fill s ~pos ~len c] modifies [s] in place, replacing [len]
+ characters with [c], starting at [pos].
+ @raise Invalid_argument if [pos] and [len] do not designate a
valid range of [s]. *)
val blit :
src:bytes -> src_pos:int -> dst:bytes -> dst_pos:int -> len:int
-> unit
-(** [blit src srcoff dst dstoff len] copies [len] bytes from sequence
- [src], starting at index [srcoff], to sequence [dst], starting at
- index [dstoff]. It works correctly even if [src] and [dst] are the
+(** [blit ~src ~src_pos ~dst ~dst_pos ~len] copies [len] bytes from sequence
+ [src], starting at index [src_pos], to sequence [dst], starting at
+ index [dst_pos]. It works correctly even if [src] and [dst] are the
same byte sequence, and the source and destination intervals
overlap.
- @raise Invalid_argument if [srcoff] and [len] do not
- designate a valid range of [src], or if [dstoff] and [len]
+ @raise Invalid_argument if [src_pos] and [len] do not
+ designate a valid range of [src], or if [dst_pos] and [len]
do not designate a valid range of [dst]. *)
val blit_string :
src:string -> src_pos:int -> dst:bytes -> dst_pos:int -> len:int
-> unit
-(** [blit src srcoff dst dstoff len] copies [len] bytes from string
- [src], starting at index [srcoff], to byte sequence [dst],
- starting at index [dstoff].
- @raise Invalid_argument if [srcoff] and [len] do not
- designate a valid range of [src], or if [dstoff] and [len]
+(** [blit ~src ~src_pos ~dst ~dst_pos ~len] copies [len] bytes from string
+ [src], starting at index [src_pos], to byte sequence [dst],
+ starting at index [dst_pos].
+ @raise Invalid_argument if [src_pos] and [len] do not
+ designate a valid range of [src], or if [dst_pos] and [len]
do not designate a valid range of [dst].
- @since 4.05.0 *)
+ @since 4.05.0 in BytesLabels *)
val concat : sep:bytes -> bytes list -> bytes
-(** [concat sep sl] concatenates the list of byte sequences [sl],
+(** [concat ~sep sl] concatenates the list of byte sequences [sl],
inserting the separator byte sequence [sep] between each, and
- returns the result as a new byte sequence. *)
+ returns the result as a new byte sequence.
+ @raise Invalid_argument if the result is longer than
+ {!Sys.max_string_length} bytes.
+ *)
val cat : bytes -> bytes -> bytes
(** [cat s1 s2] concatenates [s1] and [s2] and returns the result
- as new byte sequence.
+ as a new byte sequence.
@raise Invalid_argument if the result is longer than
{!Sys.max_string_length} bytes.
- @since 4.05.0 *)
+ @since 4.05.0 in BytesLabels *)
val iter : f:(char -> unit) -> bytes -> unit
-(** [iter f s] applies function [f] in turn to all the bytes of [s].
+(** [iter ~f s] applies function [f] in turn to all the bytes of [s].
It is equivalent to [f (get s 0); f (get s 1); ...; f (get s
(length s - 1)); ()]. *)
val iteri : f:(int -> char -> unit) -> bytes -> unit
-(** Same as {!Bytes.iter}, but the function is applied to the index of
+(** Same as {!iter}, but the function is applied to the index of
the byte as first argument and the byte itself as second
argument. *)
val map : f:(char -> char) -> bytes -> bytes
-(** [map f s] applies function [f] in turn to all the bytes of [s] and
- stores the resulting bytes in a new sequence that is returned as
- the result. *)
+(** [map ~f s] applies function [f] in turn to all the bytes of [s] (in
+ increasing index order) and stores the resulting bytes in a new sequence
+ that is returned as the result. *)
val mapi : f:(int -> char -> char) -> bytes -> bytes
-(** [mapi f s] calls [f] with each character of [s] and its
+(** [mapi ~f s] calls [f] with each character of [s] and its
index (in increasing index order) and stores the resulting bytes
in a new sequence that is returned as the result. *)
val escaped : bytes -> bytes
(** Return a copy of the argument, with special characters represented
- by escape sequences, following the lexical conventions of OCaml. *)
+ by escape sequences, following the lexical conventions of OCaml.
+ All characters outside the ASCII printable range (32..126) are
+ escaped, as well as backslash and double-quote.
+ @raise Invalid_argument if the result is longer than
+ {!Sys.max_string_length} bytes. *)
val index : bytes -> char -> int
(** [index s c] returns the index of the first occurrence of byte [c]
val index_from : bytes -> int -> char -> int
(** [index_from s i c] returns the index of the first occurrence of
- byte [c] in [s] after position [i]. [Bytes.index s c] is
- equivalent to [Bytes.index_from s 0 c].
+ byte [c] in [s] after position [i]. [index s c] is
+ equivalent to [index_from s 0 c].
@raise Invalid_argument if [i] is not a valid position in [s].
@raise Not_found if [c] does not occur in [s] after position [i]. *)
val index_from_opt: bytes -> int -> char -> int option
-(** [index_from _opts i c] returns the index of the first occurrence of
+(** [index_from_opt s i c] returns the index of the first occurrence of
byte [c] in [s] after position [i] or [None] if [c] does not occur in [s]
after position [i].
- [Bytes.index_opt s c] is equivalent to [Bytes.index_from_opt s 0 c].
+ [index_opt s c] is equivalent to [index_from_opt s 0 c].
@raise Invalid_argument if [i] is not a valid position in [s].
@since 4.05 *)
val rindex_from : bytes -> int -> char -> int
(** [rindex_from s i c] returns the index of the last occurrence of
byte [c] in [s] before position [i+1]. [rindex s c] is equivalent
- to [rindex_from s (Bytes.length s - 1) c].
+ to [rindex_from s (length s - 1) c].
@raise Invalid_argument if [i+1] is not a valid position in [s].
@raise Not_found if [c] does not occur in [s] before position [i+1]. *)
(** [rindex_from_opt s i c] returns the index of the last occurrence
of byte [c] in [s] before position [i+1] or [None] if [c] does not
occur in [s] before position [i+1]. [rindex_opt s c] is equivalent to
- [rindex_from s (Bytes.length s - 1) c].
+ [rindex_from s (length s - 1) c].
@raise Invalid_argument if [i+1] is not a valid position in [s].
@since 4.05 *)
position in [s]. *)
val uppercase : bytes -> bytes
- [@@ocaml.deprecated "Use Bytes.uppercase_ascii instead."]
+ [@@ocaml.deprecated
+ "Use Bytes.uppercase_ascii/BytesLabels.uppercase_ascii instead."]
(** Return a copy of the argument, with all lowercase letters
translated to uppercase, including accented letters of the ISO
Latin-1 (8859-1) character set.
@deprecated Functions operating on Latin-1 character set are deprecated. *)
val lowercase : bytes -> bytes
- [@@ocaml.deprecated "Use Bytes.lowercase_ascii instead."]
+ [@@ocaml.deprecated
+ "Use Bytes.lowercase_ascii/BytesLabels.lowercase_ascii instead."]
(** Return a copy of the argument, with all uppercase letters
translated to lowercase, including accented letters of the ISO
Latin-1 (8859-1) character set.
@deprecated Functions operating on Latin-1 character set are deprecated. *)
val capitalize : bytes -> bytes
- [@@ocaml.deprecated "Use Bytes.capitalize_ascii instead."]
+ [@@ocaml.deprecated
+ "Use Bytes.capitalize_ascii/BytesLabels.capitalize_ascii instead."]
(** Return a copy of the argument, with the first character set to uppercase,
- using the ISO Latin-1 (8859-1) character set..
+ using the ISO Latin-1 (8859-1) character set.
@deprecated Functions operating on Latin-1 character set are deprecated. *)
val uncapitalize : bytes -> bytes
- [@@ocaml.deprecated "Use Bytes.uncapitalize_ascii instead."]
+ [@@ocaml.deprecated
+ "Use Bytes.uncapitalize_ascii/BytesLabels.uncapitalize_ascii instead."]
(** Return a copy of the argument, with the first character set to lowercase,
- using the ISO Latin-1 (8859-1) character set..
+ using the ISO Latin-1 (8859-1) character set.
@deprecated Functions operating on Latin-1 character set are deprecated. *)
val uppercase_ascii : bytes -> bytes
(** Return a copy of the argument, with all lowercase letters
translated to uppercase, using the US-ASCII character set.
- @since 4.05.0 *)
+ @since 4.03.0 (4.05.0 in BytesLabels) *)
val lowercase_ascii : bytes -> bytes
(** Return a copy of the argument, with all uppercase letters
translated to lowercase, using the US-ASCII character set.
- @since 4.05.0 *)
+ @since 4.03.0 (4.05.0 in BytesLabels) *)
val capitalize_ascii : bytes -> bytes
(** Return a copy of the argument, with the first character set to uppercase,
using the US-ASCII character set.
- @since 4.05.0 *)
+ @since 4.03.0 (4.05.0 in BytesLabels) *)
val uncapitalize_ascii : bytes -> bytes
(** Return a copy of the argument, with the first character set to lowercase,
using the US-ASCII character set.
- @since 4.05.0 *)
+ @since 4.03.0 (4.05.0 in BytesLabels) *)
type t = bytes
(** An alias for the type of byte sequences. *)
val equal: t -> t -> bool
(** The equality function for byte sequences.
- @since 4.05.0 *)
+ @since 4.03.0 (4.05.0 in BytesLabels) *)
+
+(** {1:unsafe Unsafe conversions (for advanced users)}
+
+ This section describes unsafe, low-level conversion functions
+ between [bytes] and [string]. They do not copy the internal data;
+ used improperly, they can break the immutability invariant on
+ strings provided by the [-safe-string] option. They are available for
+ expert library authors, but for most purposes you should use the
+ always-correct {!to_string} and {!of_string} instead.
+*)
+
+val unsafe_to_string : bytes -> string
+(** Unsafely convert a byte sequence into a string.
+
+ To reason about the use of [unsafe_to_string], it is convenient to
+ consider an "ownership" discipline. A piece of code that
+ manipulates some data "owns" it; there are several disjoint ownership
+ modes, including:
+ - Unique ownership: the data may be accessed and mutated
+ - Shared ownership: the data has several owners, that may only
+ access it, not mutate it.
+
+ Unique ownership is linear: passing the data to another piece of
+ code means giving up ownership (we cannot write the
+ data again). A unique owner may decide to make the data shared
+ (giving up mutation rights on it), but shared data may not become
+ uniquely-owned again.
+
+ [unsafe_to_string s] can only be used when the caller owns the byte
+ sequence [s] -- either uniquely or as shared immutable data. The
+ caller gives up ownership of [s], and gains ownership of the
+ returned string.
+
+ There are two valid use-cases that respect this ownership
+ discipline:
+
+ 1. Creating a string by initializing and mutating a byte sequence
+ that is never changed after initialization is performed.
+
+ {[
+let string_init len f : string =
+ let s = Bytes.create len in
+ for i = 0 to len - 1 do Bytes.set s i (f i) done;
+ Bytes.unsafe_to_string s
+ ]}
+
+ This function is safe because the byte sequence [s] will never be
+ accessed or mutated after [unsafe_to_string] is called. The
+ [string_init] code gives up ownership of [s], and returns the
+ ownership of the resulting string to its caller.
+
+ Note that it would be unsafe if [s] was passed as an additional
+ parameter to the function [f] as it could escape this way and be
+ mutated in the future -- [string_init] would give up ownership of
+ [s] to pass it to [f], and could not call [unsafe_to_string]
+ safely.
+
+ We have provided the {!String.init}, {!String.map} and
+ {!String.mapi} functions to cover most cases of building
+ new strings. You should prefer those over [to_string] or
+ [unsafe_to_string] whenever applicable.
+
+ 2. Temporarily giving ownership of a byte sequence to a function
+ that expects a uniquely owned string and returns ownership back, so
+ that we can mutate the sequence again after the call ended.
+
+ {[
+let bytes_length (s : bytes) =
+ String.length (Bytes.unsafe_to_string s)
+ ]}
+
+ In this use-case, we do not promise that [s] will never be mutated
+ after the call to [bytes_length s]. The {!String.length} function
+ temporarily borrows unique ownership of the byte sequence
+ (and sees it as a [string]), but returns this ownership back to
+ the caller, which may assume that [s] is still a valid byte
+ sequence after the call. Note that this is only correct because we
+ know that {!String.length} does not capture its argument -- it could
+ escape by a side-channel such as a memoization combinator.
+
+ The caller may not mutate [s] while the string is borrowed (it has
+ temporarily given up ownership). This affects concurrent programs,
+ but also higher-order functions: if {!String.length} returned
+ a closure to be called later, [s] should not be mutated until this
+ closure is fully applied and returns ownership.
+*)
+
+val unsafe_of_string : string -> bytes
+(** Unsafely convert a shared string to a byte sequence that should
+ not be mutated.
+
+ The same ownership discipline that makes [unsafe_to_string]
+ correct applies to [unsafe_of_string]: you may use it if you were
+ the owner of the [string] value, and you will own the return
+ [bytes] in the same mode.
+
+ In practice, unique ownership of string values is extremely
+ difficult to reason about correctly. You should always assume
+ strings are shared, never uniquely owned.
+
+ For example, string literals are implicitly shared by the
+ compiler, so you never uniquely own them.
+
+ {[
+let incorrect = Bytes.unsafe_of_string "hello"
+let s = Bytes.of_string "hello"
+ ]}
+
+ The first declaration is incorrect, because the string literal
+ ["hello"] could be shared by the compiler with other parts of the
+ program, and mutating [incorrect] is a bug. You must always use
+ the second version, which performs a copy and is thus correct.
+
+ Assuming unique ownership of strings that are not string
+ literals, but are (partly) built from string literals, is also
+ incorrect. For example, mutating [unsafe_of_string ("foo" ^ s)]
+ could mutate the shared string ["foo"] -- assuming a rope-like
+ representation of strings. More generally, functions operating on
+ strings will assume shared ownership, they do not preserve unique
+ ownership. It is thus incorrect to assume unique ownership of the
+ result of [unsafe_of_string].
+
+ The only case we have reasonable confidence is safe is if the
+ produced [bytes] is shared -- used as an immutable byte
+ sequence. This is possibly useful for incremental migration of
+ low-level programs that manipulate immutable sequences of bytes
+ (for example {!Marshal.from_bytes}) and previously used the
+ [string] type for this purpose.
+*)
+
(** {1 Iterators} *)
= "caml_blit_string" [@@noalloc]
external unsafe_fill :
bytes -> pos:int -> len:int -> char -> unit = "caml_fill_bytes" [@@noalloc]
-val unsafe_to_string : bytes -> string
-val unsafe_of_string : string -> bytes
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Gabriel Scherer, projet Partout, INRIA Paris-Saclay *)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* CamlinternalAtomic is a dependency of Stdlib, so it is compiled with
+ -nopervasives. *)
+external ( == ) : 'a -> 'a -> bool = "%eq"
+external ( + ) : int -> int -> int = "%addint"
+external ignore : 'a -> unit = "%ignore"
+
+(* We are not reusing ('a ref) directly to make it easier to reason
+ about atomicity if we wish to: even in a sequential implementation,
+ signals and other asynchronous callbacks might break atomicity. *)
+type 'a t = {mutable v: 'a}
+
+let make v = {v}
+let get r = r.v
+let set r v = r.v <- v
+
+(* The following functions are set to never be inlined: Flambda is
+ allowed to move surrounding code inside the critical section,
+ including allocations. *)
+
+let[@inline never] exchange r v =
+ (* BEGIN ATOMIC *)
+ let cur = r.v in
+ r.v <- v;
+ (* END ATOMIC *)
+ cur
+
+let[@inline never] compare_and_set r seen v =
+ (* BEGIN ATOMIC *)
+ let cur = r.v in
+ if cur == seen then (
+ r.v <- v;
+ (* END ATOMIC *)
+ true
+ ) else
+ false
+
+let[@inline never] fetch_and_add r n =
+ (* BEGIN ATOMIC *)
+ let cur = r.v in
+ r.v <- (cur + n);
+ (* END ATOMIC *)
+ cur
+
+let incr r = ignore (fetch_and_add r 1)
+let decr r = ignore (fetch_and_add r (-1))
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Stephen Dolan, University of Cambridge *)
+(* Guillaume Munch-Maccagnoni, projet Gallinette, INRIA *)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* The documentation is in atomic.mli. CamlinternalAtomic exists in
+ order to be a dependency of Stdlib. More precisely, the option
+ modules_before_stdlib used in stdlib/dune does not support the
+ Stdlib__ prefix trick. *)
+
+type !'a t
+val make : 'a -> 'a t
+val get : 'a t -> 'a
+val set : 'a t -> 'a -> unit
+val exchange : 'a t -> 'a -> 'a
+val compare_and_set : 'a t -> 'a -> 'a -> bool
+val fetch_and_add : int t -> int -> int
+val incr : int t -> unit
+val decr : int t -> unit
and get_prec () = prec_used := true; prec
and get_padprec () = pad_used := true; padprec in
- let get_int_pad () =
+ let get_int_pad () : (x,y) padding =
(* %5.3d is accepted and meaningful: pad to length 5 with
spaces, but first pad with zeros upto length 3 (0-padding
is the interpretation of "precision" for integer formats).
| Arg_padding _ as pad, _ -> pad in
(* Check that padty <> Zeros. *)
- let check_no_0 symb (type a) (type b) (pad : (a, b) padding) =
+ let check_no_0 symb (type a b) (pad : (a, b) padding) : (a,b) padding =
match pad with
| No_padding -> pad
| Lit_padding ((Left | Right), _) -> pad
(* [force] is not used, since [Lazy.force] is declared as a primitive
- whose code inlines the tag tests of its argument. This function is
- here for the sake of completeness, and for debugging purpose. *)
+ whose code inlines the tag tests of its argument, except when afl
+ instrumentation is turned on. *)
let force (lzv : 'arg lazy_t) =
+ (* Using [Sys.opaque_identity] prevents two potential problems:
+ - If the value is known to have Forward_tag, then its tag could have
+ changed during GC, so that information must be forgotten (see GPR#713
+ and issue #7301)
+ - If the value is known to be immutable, then if the compiler
+ cannot prove that the last branch is not taken it will issue a
+ warning 59 (modification of an immutable value) *)
+ let lzv = Sys.opaque_identity lzv in
let x = Obj.repr lzv in
let t = Obj.tag x in
if t = Obj.forward_tag then (Obj.obj (Obj.field x 0) : 'arg) else
Obj.set_field o i (Obj.field n i)
done
+let overwrite_closure o n =
+ (* We need to use the [raw_field] functions at least on the code
+ pointer, which is not a valid value in -no-naked-pointers
+ mode. *)
+ assert (Obj.tag n = Obj.closure_tag);
+ assert (Obj.size o >= Obj.size n);
+ let n_start_env = Obj.Closure.((info n).start_env) in
+ let o_start_env = Obj.Closure.((info o).start_env) in
+ (* if the environment of n starts before the one of o,
+ clear the raw fields in between. *)
+ for i = n_start_env to o_start_env - 1 do
+ Obj.set_raw_field o i Nativeint.one
+ done;
+ (* if the environment of o starts before the one of n,
+ clear the environment fields in between. *)
+ for i = o_start_env to n_start_env - 1 do
+ Obj.set_field o i (Obj.repr ())
+ done;
+ for i = 0 to n_start_env - 1 do
+ (* code pointers, closure info fields, infix headers *)
+ Obj.set_raw_field o i (Obj.raw_field n i)
+ done;
+ for i = n_start_env to Obj.size n - 1 do
+ (* environment fields *)
+ Obj.set_field o i (Obj.field n i)
+ done;
+ for i = Obj.size n to Obj.size o - 1 do
+ (* clear the leftover space *)
+ Obj.set_field o i (Obj.repr ())
+ done;
+ ()
+
let rec init_mod loc shape =
match shape with
| Function ->
let template =
Obj.repr (fun _ -> raise (Undefined_recursive_module loc))
in
- overwrite closure template;
+ overwrite_closure closure template;
closure
| Lazy ->
Obj.repr (lazy (raise (Undefined_recursive_module loc)))
&& (Obj.size n = Obj.size o
|| (Sys.backend_type = Sys.Native
&& Obj.size n <= Obj.size o))
- then begin overwrite o n end
- else overwrite o (Obj.repr (fun x -> (Obj.obj n : _ -> _) x))
+ then begin overwrite_closure o n end
+ else overwrite_closure o (Obj.repr (fun x -> (Obj.obj n : _ -> _) x))
| Lazy ->
if Obj.tag n = Obj.lazy_tag then
Obj.set_field o 0 (Obj.field n 0)
(** MD5 message digest.
This module provides functions to compute 128-bit 'digests' of
- arbitrary-length strings or files. The digests are of cryptographic
- quality: it is very hard, given a digest, to forge a string having
- that digest. The algorithm used is MD5. This module should not be
- used for secure and sensitive cryptographic applications. For these
- kind of applications more recent and stronger cryptographic
- primitives should be used instead.
+ arbitrary-length strings or files. The algorithm used is MD5.
+
+ The MD5 hash function is not cryptographically secure.
+ Hence, this module should not be used for security-sensitive
+ applications. More recent, stronger cryptographic primitives
+ should be used instead.
*)
type t = string
(exit_module std_exit)
(internal_modules Camlinternal*)
(modules_before_stdlib
- camlinternalFormatBasics))
+ camlinternalFormatBasics
+ camlinternalAtomic))
(flags (:standard -w -9 -nolabels))
(preprocess
(per_module
((action
- (run awk -v dune_wrapped=true
- -f %{dep:expand_module_aliases.awk} %{input-file}))
- stdlib))))
+ (progn
+ ; FIXME: remove after 4.12
+ (run sed -i s/loc_FUNCTION/loc_POS/ %{input-file})
+ (run awk -v dune_wrapped=true
+ -f %{dep:expand_module_aliases.awk} %{input-file})))
+ stdlib)
+ (; FIXME: remove after 4.12 (this erases injectivity annotations)
+ (action (run sed "s/\\!\\([-+]*'\\)/\\1/g" %{input-file}))
+ atomic bigarray camlinternalAtomic camlinternalOO ephemeron hashtbl map
+ moreLabels queue stack stream weak))))
(rule
(targets sys.ml)
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Gabriel Scherer, projet Parsifal, INRIA Saclay *)
+(* *)
+(* Copyright 2019 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+type ('a, 'b) t = Left of 'a | Right of 'b
+
+let left v = Left v
+let right v = Right v
+
+let is_left = function
+| Left _ -> true
+| Right _ -> false
+
+let is_right = function
+| Left _ -> false
+| Right _ -> true
+
+let find_left = function
+| Left v -> Some v
+| Right _ -> None
+
+let find_right = function
+| Left _ -> None
+| Right v -> Some v
+
+let map_left f = function
+| Left v -> Left (f v)
+| Right _ as e -> e
+
+let map_right f = function
+| Left _ as e -> e
+| Right v -> Right (f v)
+
+let map ~left ~right = function
+| Left v -> Left (left v)
+| Right v -> Right (right v)
+
+let fold ~left ~right = function
+| Left v -> left v
+| Right v -> right v
+
+let iter = fold
+
+let for_all = fold
+
+let equal ~left ~right e1 e2 = match e1, e2 with
+| Left v1, Left v2 -> left v1 v2
+| Right v1, Right v2 -> right v1 v2
+| Left _, Right _ | Right _, Left _ -> false
+
+let compare ~left ~right e1 e2 = match e1, e2 with
+| Left v1, Left v2 -> left v1 v2
+| Right v1, Right v2 -> right v1 v2
+| Left _, Right _ -> (-1)
+| Right _, Left _ -> 1
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Gabriel Scherer, projet Parsifal, INRIA Saclay *)
+(* *)
+(* Copyright 2019 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(** Either type.
+
+ Either is the simplest and most generic sum/variant type:
+ a value of [('a, 'b) Either.t] is either a [Left (v : 'a)]
+ or a [Right (v : 'b)].
+
+ It is a natural choice in the API of generic functions where values
+ could fall in two different cases, possibly at different types,
+ without assigning a specific meaning to what each case should be.
+
+ For example:
+
+{[List.partition_map:
+ ('a -> ('b, 'c) Either.t) -> 'a list -> 'b list * 'c list]}
+
+ If you are looking for a parametrized type where
+ one alternative means success and the other means failure,
+ you should use the more specific type {!Result.t}.
+
+ @since 4.12
+*)
+
+(* Unlike [result], no [either] type is made available in Stdlib,
+ one needs to access [Either.t] explicitly:
+
+ - This type is less common in typical OCaml codebases,
+ which prefer domain-specific variant types whose constructors
+ carry more meaning.
+ - Adding this to Stdlib would raise warnings in existing codebases
+ that already use a constructor named Left or Right:
+ + when opening a module that exports such a name,
+ warning 45 is raised
+ + adding a second constructor of the same name in scope kicks
+ in the disambiguation mechanisms, and warning 41 may now
+ be raised by existing code.
+
+ If the use becomes more common in the future we can always
+ revisit this choice.
+*)
+
+type ('a, 'b) t = Left of 'a | Right of 'b (**)
+(** A value of [('a, 'b) Either.t] contains
+ either a value of ['a] or a value of ['b] *)
+
+val left : 'a -> ('a, 'b) t
+(** [left v] is [Left v]. *)
+
+val right : 'b -> ('a, 'b) t
+(** [right v] is [Right v]. *)
+
+val is_left : ('a, 'b) t -> bool
+(** [is_left (Left v)] is [true], [is_left (Right v)] is [false]. *)
+
+val is_right : ('a, 'b) t -> bool
+(** [is_right (Left v)] is [false], [is_right (Right v)] is [true]. *)
+
+val find_left : ('a, 'b) t -> 'a option
+(** [find_left (Left v)] is [Some v], [find_left (Right _)] is [None] *)
+
+val find_right : ('a, 'b) t -> 'b option
+(** [find_right (Right v)] is [Some v], [find_right (Left _)] is [None] *)
+
+val map_left : ('a1 -> 'a2) -> ('a1, 'b) t -> ('a2, 'b) t
+(** [map_left f e] is [Left (f v)] if [e] is [Left v]
+ and [e] if [e] is [Right _]. *)
+
+val map_right : ('b1 -> 'b2) -> ('a, 'b1) t -> ('a, 'b2) t
+(** [map_right f e] is [Right (f v)] if [e] is [Right v]
+ and [e] if [e] is [Left _]. *)
+
+val map :
+ left:('a1 -> 'a2) -> right:('b1 -> 'b2) -> ('a1, 'b1) t -> ('a2, 'b2) t
+(** [map ~left ~right (Left v)] is [Left (left v)],
+ [map ~left ~right (Right v)] is [Right (right v)]. *)
+
+val fold : left:('a -> 'c) -> right:('b -> 'c) -> ('a, 'b) t -> 'c
+(** [fold ~left ~right (Left v)] is [left v], and
+ [fold ~left ~right (Right v)] is [right v]. *)
+
+val iter : left:('a -> unit) -> right:('b -> unit) -> ('a, 'b) t -> unit
+(** [iter ~left ~right (Left v)] is [left v], and
+ [iter ~left ~right (Right v)] is [right v]. *)
+
+val for_all : left:('a -> bool) -> right:('b -> bool) -> ('a, 'b) t -> bool
+(** [for_all ~left ~right (Left v)] is [left v], and
+ [for_all ~left ~right (Right v)] is [right v]. *)
+
+val equal :
+ left:('a -> 'a -> bool) -> right:('b -> 'b -> bool) ->
+ ('a, 'b) t -> ('a, 'b) t -> bool
+(** [equal ~left ~right e0 e1] tests equality of [e0] and [e1] using [left]
+ and [right] to respectively compare values wrapped by [Left _] and
+ [Right _]. *)
+
+val compare :
+ left:('a -> 'a -> int) -> right:('b -> 'b -> int) ->
+ ('a, 'b) t -> ('a, 'b) t -> int
+(** [compare ~left ~right e0 e1] totally orders [e0] and [e1] using [left] and
+ [right] to respectively compare values wrapped by [Left _ ] and [Right _].
+ [Left _] values are smaller than [Right _] values. *)
(* *)
(**************************************************************************)
-(** Ephemerons and weak hash tables *)
+(** Ephemerons and weak hash tables.
-(** Ephemerons and weak hash tables are useful when one wants to cache
+ Ephemerons and weak hash tables are useful when one wants to cache
or memorize the computation of a function, as long as the
arguments and the function are used, without creating memory leaks
by continuously keeping old computation results that are not
The seed is similar to the one of {!Hashtbl.MakeSeeded}. *)
end
+(** Ephemerons with one key. *)
module K2 : sig
type ('k1,'k2,'d) t (** an ephemeron with two keys *)
The seed is similar to the one of {!Hashtbl.MakeSeeded}. *)
end
+(** Emphemerons with two keys. *)
module Kn : sig
type ('k,'d) t (** an ephemeron with an arbitrary number of keys
The seed is similar to the one of {!Hashtbl.MakeSeeded}. *)
end
+(** Emphemerons with arbitrary number of keys of the same type. *)
module GenHashTable: sig
(** Define a hash table on generic containers which have a notion of
automatically remove it. *)
type equal =
- | ETrue | EFalse
+ | ETrue
+ | EFalse
| EDead (** the container is dead *)
module MakeSeeded(H:
for keeping the information given *)
end
+(** Hash tables on generic containers with notion of death and aliveness. *)
NR == 1 { printf ("# 1 \"%s\"\n", FILENAME) }
/\(\*MODULE_ALIASES\*\)\r?/ { state=1 }
{ if (state==0)
- print;
+ { if (FILENAME ~ /Labels/ &&
+ sub(/@since [^(]* \(/, "@since ")) sub(/ in [^)]*\)/, ""); print; }
else if (state==1)
state=2;
else if ($1 == "module")
Under Win32, additional quoting is performed as required by the
[cmd.exe] shell that is called by {!Sys.command}.
@raise Failure if the command cannot be escaped on the current platform.
+ @since 4.10.0
*)
let unsafe_fill a ofs len v =
for i = ofs to ofs + len - 1 do unsafe_set a i v done
- let unsafe_blit src sofs dst dofs len =
- for i = 0 to len - 1 do
- unsafe_set dst (dofs + i) (unsafe_get src (sofs + i))
- done
+ external unsafe_blit: t -> int -> t -> int -> int -> unit =
+ "caml_floatarray_blit" [@@noalloc]
let check a ofs len msg =
if ofs < 0 || len < 0 || ofs + len < 0 || ofs + len > length a then
(* *)
(**************************************************************************)
-(** {1 Floating-point arithmetic}
+(* NOTE:
+ If this file is float.template.mli, run tools/sync_stdlib_docs after editing
+ it to generate float.mli.
+
+ If this file is float.mli, do not edit it directly -- edit
+ templates/float.template.mli instead.
+ *)
+
+(** Floating-point arithmetic.
OCaml's floating-point numbers follow the
IEEE 754 standard, using double precision (64 bits) numbers.
[neg_infinity] for [-1.0 /. 0.0], and [nan] ('not a number')
for [0.0 /. 0.0]. These special numbers then propagate through
floating-point computations as expected: for instance,
- [1.0 /. infinity] is [0.0], and any arithmetic operation with [nan]
- as argument returns [nan] as result.
+ [1.0 /. infinity] is [0.0], basic arithmetic operations
+ ([+.], [-.], [*.], [/.]) with [nan] as an argument return [nan], ...
@since 4.07.0
*)
floating-point number greater than [1.0]. *)
val is_finite : float -> bool
-(** [is_finite x] is [true] iff [x] is finite i.e., not infinite and
+(** [is_finite x] is [true] if and only if [x] is finite i.e., not infinite and
not {!nan}.
@since 4.08.0 *)
val is_infinite : float -> bool
-(** [is_infinite x] is [true] iff [x] is {!infinity} or {!neg_infinity}.
+(** [is_infinite x] is [true] if and only if [x] is {!infinity} or
+ {!neg_infinity}.
@since 4.08.0 *)
val is_nan : float -> bool
-(** [is_nan x] is [true] iff [x] is not a number (see {!nan}).
+(** [is_nan x] is [true] if and only if [x] is not a number (see {!nan}).
@since 4.08.0 *)
val is_integer : float -> bool
-(** [is_integer x] is [true] iff [x] is an integer.
+(** [is_integer x] is [true] if and only if [x] is an integer.
@since 4.08.0 *)
external sign_bit : (float [@unboxed]) -> bool
= "caml_signbit_float" "caml_signbit" [@@noalloc]
-(** [sign_bit x] is [true] iff the sign bit of [x] is set.
+(** [sign_bit x] is [true] if and only if the sign bit of [x] is set.
For example [sign_bit 1.] and [signbit 0.] are [false] while
[sign_bit (-1.)] and [sign_bit (-0.)] are [true].
(** The hash function for floating-point numbers. *)
module Array : sig
-
type t = floatarray
- (** The type of float arrays with packed representation. @since 4.08.0 *)
+ (** The type of float arrays with packed representation.
+ @since 4.08.0
+ *)
val length : t -> int
(** Return the length (number of elements) of the given floatarray. *)
(** Same as {!append}, but concatenates a list of floatarrays. *)
val sub : t -> int -> int -> t
- (** [sub a start len] returns a fresh floatarray of length [len],
- containing the elements number [start] to [start + len - 1]
+ (** [sub a pos len] returns a fresh floatarray of length [len],
+ containing the elements number [pos] to [pos + len - 1]
of floatarray [a].
- @raise Invalid_argument if [start] and [len] do not
+ @raise Invalid_argument if [pos] and [len] do not
designate a valid subarray of [a]; that is, if
- [start < 0], or [len < 0], or [start + len > length a]. *)
+ [pos < 0], or [len < 0], or [pos + len > length a]. *)
val copy : t -> t
(** [copy a] returns a copy of [a], that is, a fresh floatarray
containing the same elements as [a]. *)
val fill : t -> int -> int -> float -> unit
- (** [fill a ofs len x] modifies the floatarray [a] in place,
- storing [x] in elements number [ofs] to [ofs + len - 1].
- @raise Invalid_argument if [ofs] and [len] do not
+ (** [fill a pos len x] modifies the floatarray [a] in place,
+ storing [x] in elements number [pos] to [pos + len - 1].
+ @raise Invalid_argument if [pos] and [len] do not
designate a valid subarray of [a]. *)
val blit : t -> int -> t -> int -> int -> unit
- (** [blit v1 o1 v2 o2 len] copies [len] elements
- from floatarray [v1], starting at element number [o1], to floatarray [v2],
- starting at element number [o2]. It works correctly even if
- [v1] and [v2] are the same floatarray, and the source and
+ (** [blit src src_pos dst dst_pos len] copies [len] elements
+ from floatarray [src], starting at element number [src_pos],
+ to floatarray [dst], starting at element number [dst_pos].
+ It works correctly even if
+ [src] and [dst] are the same floatarray, and the source and
destination chunks overlap.
- @raise Invalid_argument if [o1] and [len] do not
- designate a valid subarray of [v1], or if [o2] and [len] do not
- designate a valid subarray of [v2]. *)
+ @raise Invalid_argument if [src_pos] and [len] do not
+ designate a valid subarray of [src], or if [dst_pos] and [len] do not
+ designate a valid subarray of [dst]. *)
val to_list : t -> float list
(** [to_list a] returns the list of all the elements of [a]. *)
and the element itself as second argument. *)
val fold_left : ('a -> float -> 'a) -> 'a -> t -> 'a
- (** [fold_left f x a] computes
- [f (... (f (f x a.(0)) a.(1)) ...) a.(n-1)],
- where [n] is the length of the floatarray [a]. *)
+ (** [fold_left f x init] computes
+ [f (... (f (f x init.(0)) init.(1)) ...) init.(n-1)],
+ where [n] is the length of the floatarray [init]. *)
val fold_right : (float -> 'a -> 'a) -> t -> 'a -> 'a
- (** [fold_right f a x] computes
- [f a.(0) (f a.(1) ( ... (f a.(n-1) x) ...))],
+ (** [fold_right f a init] computes
+ [f a.(0) (f a.(1) ( ... (f a.(n-1) init) ...))],
where [n] is the length of the floatarray [a]. *)
(** {2 Iterators on two arrays} *)
(** {2 Array scanning} *)
val for_all : (float -> bool) -> t -> bool
- (** [for_all p [|a1; ...; an|]] checks if all elements of the floatarray
- satisfy the predicate [p]. That is, it returns
- [(p a1) && (p a2) && ... && (p an)]. *)
+ (** [for_all f [|a1; ...; an|]] checks if all elements of the floatarray
+ satisfy the predicate [f]. That is, it returns
+ [(f a1) && (f a2) && ... && (f an)]. *)
val exists : (float -> bool) -> t -> bool
- (** [exists p [|a1; ...; an|]] checks if at least one element of
- the floatarray satisfies the predicate [p]. That is, it returns
- [(p a1) || (p a2) || ... || (p an)]. *)
+ (** [exists f [|a1; ...; an|]] checks if at least one element of
+ the floatarray satisfies the predicate [f]. That is, it returns
+ [(f a1) || (f a2) || ... || (f an)]. *)
val mem : float -> t -> bool
- (** [mem a l] is true if and only if there is an element of [l] that is
- structurally equal to [a], i.e. there is an [x] in [l] such
+ (** [mem a set] is true if and only if there is an element of [set] that is
+ structurally equal to [a], i.e. there is an [x] in [set] such
that [compare a x = 0]. *)
val mem_ieee : float -> t -> bool
Specification of the comparison function:
Let [a] be the floatarray and [cmp] the comparison function. The following
must be true for all [x], [y], [z] in [a] :
-- [cmp x y] > 0 if and only if [cmp y x] < 0
-- if [cmp x y] >= 0 and [cmp y z] >= 0 then [cmp x z] >= 0
+ - [cmp x y] > 0 if and only if [cmp y x] < 0
+ - if [cmp x y] >= 0 and [cmp y z] >= 0 then [cmp x z] >= 0
When [sort] returns, [a] contains the same elements as before,
reordered in such a way that for all i and j valid indices of [a] :
-- [cmp a.(i) a.(j)] >= 0 if and only if i >= j
+ - [cmp a.(i) a.(j)] >= 0 if and only if i >= j
*)
val stable_sort : (float -> float -> int) -> t -> unit
(** [map_from_array f a] applies function [f] to all the elements of [a],
and builds a floatarray with the results returned by [f]. *)
+ (**/**)
+
(** {2 Undocumented functions} *)
(* These functions are for system use only. Do not call directly. *)
external unsafe_get : t -> int -> float = "%floatarray_unsafe_get"
external unsafe_set : t -> int -> float -> unit = "%floatarray_unsafe_set"
+
end
+(** Float arrays with packed representation. *)
module ArrayLabels : sig
-
type t = floatarray
+ (** The type of float arrays with packed representation.
+ @since 4.08.0
+ *)
+
val length : t -> int
+ (** Return the length (number of elements) of the given floatarray. *)
+
val get : t -> int -> float
+ (** [get a n] returns the element number [n] of floatarray [a].
+ @raise Invalid_argument if [n] is outside the range 0 to
+ [(length a - 1)]. *)
+
val set : t -> int -> float -> unit
+ (** [set a n x] modifies floatarray [a] in place, replacing element
+ number [n] with [x].
+ @raise Invalid_argument if [n] is outside the range 0 to
+ [(length a - 1)]. *)
+
val make : int -> float -> t
+ (** [make n x] returns a fresh floatarray of length [n], initialized with [x].
+ @raise Invalid_argument if [n < 0] or [n > Sys.max_floatarray_length]. *)
+
val create : int -> t
+ (** [create n] returns a fresh floatarray of length [n],
+ with uninitialized data.
+ @raise Invalid_argument if [n < 0] or [n > Sys.max_floatarray_length]. *)
+
val init : int -> f:(int -> float) -> t
+ (** [init n ~f] returns a fresh floatarray of length [n],
+ with element number [i] initialized to the result of [f i].
+ In other terms, [init n ~f] tabulates the results of [f]
+ applied to the integers [0] to [n-1].
+ @raise Invalid_argument if [n < 0] or [n > Sys.max_floatarray_length]. *)
+
val append : t -> t -> t
+ (** [append v1 v2] returns a fresh floatarray containing the
+ concatenation of the floatarrays [v1] and [v2].
+ @raise Invalid_argument if
+ [length v1 + length v2 > Sys.max_floatarray_length]. *)
+
val concat : t list -> t
+ (** Same as {!append}, but concatenates a list of floatarrays. *)
+
val sub : t -> pos:int -> len:int -> t
+ (** [sub a ~pos ~len] returns a fresh floatarray of length [len],
+ containing the elements number [pos] to [pos + len - 1]
+ of floatarray [a].
+ @raise Invalid_argument if [pos] and [len] do not
+ designate a valid subarray of [a]; that is, if
+ [pos < 0], or [len < 0], or [pos + len > length a]. *)
+
val copy : t -> t
+ (** [copy a] returns a copy of [a], that is, a fresh floatarray
+ containing the same elements as [a]. *)
+
val fill : t -> pos:int -> len:int -> float -> unit
+ (** [fill a ~pos ~len x] modifies the floatarray [a] in place,
+ storing [x] in elements number [pos] to [pos + len - 1].
+ @raise Invalid_argument if [pos] and [len] do not
+ designate a valid subarray of [a]. *)
+
val blit : src:t -> src_pos:int -> dst:t -> dst_pos:int -> len:int -> unit
+ (** [blit ~src ~src_pos ~dst ~dst_pos ~len] copies [len] elements
+ from floatarray [src], starting at element number [src_pos],
+ to floatarray [dst], starting at element number [dst_pos].
+ It works correctly even if
+ [src] and [dst] are the same floatarray, and the source and
+ destination chunks overlap.
+ @raise Invalid_argument if [src_pos] and [len] do not
+ designate a valid subarray of [src], or if [dst_pos] and [len] do not
+ designate a valid subarray of [dst]. *)
+
val to_list : t -> float list
+ (** [to_list a] returns the list of all the elements of [a]. *)
+
val of_list : float list -> t
+ (** [of_list l] returns a fresh floatarray containing the elements
+ of [l].
+ @raise Invalid_argument if the length of [l] is greater than
+ [Sys.max_floatarray_length].*)
+
+ (** {2 Iterators} *)
+
val iter : f:(float -> unit) -> t -> unit
+ (** [iter ~f a] applies function [f] in turn to all
+ the elements of [a]. It is equivalent to
+ [f a.(0); f a.(1); ...; f a.(length a - 1); ()]. *)
+
val iteri : f:(int -> float -> unit) -> t -> unit
+ (** Same as {!iter}, but the
+ function is applied with the index of the element as first argument,
+ and the element itself as second argument. *)
+
val map : f:(float -> float) -> t -> t
+ (** [map ~f a] applies function [f] to all the elements of [a],
+ and builds a floatarray with the results returned by [f]. *)
+
val mapi : f:(int -> float -> float) -> t -> t
+ (** Same as {!map}, but the
+ function is applied to the index of the element as first argument,
+ and the element itself as second argument. *)
+
val fold_left : f:('a -> float -> 'a) -> init:'a -> t -> 'a
+ (** [fold_left ~f x ~init] computes
+ [f (... (f (f x init.(0)) init.(1)) ...) init.(n-1)],
+ where [n] is the length of the floatarray [init]. *)
+
val fold_right : f:(float -> 'a -> 'a) -> t -> init:'a -> 'a
+ (** [fold_right f a init] computes
+ [f a.(0) (f a.(1) ( ... (f a.(n-1) init) ...))],
+ where [n] is the length of the floatarray [a]. *)
+
+ (** {2 Iterators on two arrays} *)
+
val iter2 : f:(float -> float -> unit) -> t -> t -> unit
+ (** [Array.iter2 ~f a b] applies function [f] to all the elements of [a]
+ and [b].
+ @raise Invalid_argument if the floatarrays are not the same size. *)
+
val map2 : f:(float -> float -> float) -> t -> t -> t
+ (** [map2 ~f a b] applies function [f] to all the elements of [a]
+ and [b], and builds a floatarray with the results returned by [f]:
+ [[| f a.(0) b.(0); ...; f a.(length a - 1) b.(length b - 1)|]].
+ @raise Invalid_argument if the floatarrays are not the same size. *)
+
+ (** {2 Array scanning} *)
+
val for_all : f:(float -> bool) -> t -> bool
+ (** [for_all ~f [|a1; ...; an|]] checks if all elements of the floatarray
+ satisfy the predicate [f]. That is, it returns
+ [(f a1) && (f a2) && ... && (f an)]. *)
+
val exists : f:(float -> bool) -> t -> bool
+ (** [exists f [|a1; ...; an|]] checks if at least one element of
+ the floatarray satisfies the predicate [f]. That is, it returns
+ [(f a1) || (f a2) || ... || (f an)]. *)
+
val mem : float -> set:t -> bool
+ (** [mem a ~set] is true if and only if there is an element of [set] that is
+ structurally equal to [a], i.e. there is an [x] in [set] such
+ that [compare a x = 0]. *)
+
val mem_ieee : float -> set:t -> bool
+ (** Same as {!mem}, but uses IEEE equality instead of structural equality. *)
+
+ (** {2 Sorting} *)
+
val sort : cmp:(float -> float -> int) -> t -> unit
+ (** Sort a floatarray in increasing order according to a comparison
+ function. The comparison function must return 0 if its arguments
+ compare as equal, a positive integer if the first is greater,
+ and a negative integer if the first is smaller (see below for a
+ complete specification). For example, {!Stdlib.compare} is
+ a suitable comparison function. After calling [sort], the
+ array is sorted in place in increasing order.
+ [sort] is guaranteed to run in constant heap space
+ and (at most) logarithmic stack space.
+
+ The current implementation uses Heap Sort. It runs in constant
+ stack space.
+
+ Specification of the comparison function:
+ Let [a] be the floatarray and [cmp] the comparison function. The following
+ must be true for all [x], [y], [z] in [a] :
+ - [cmp x y] > 0 if and only if [cmp y x] < 0
+ - if [cmp x y] >= 0 and [cmp y z] >= 0 then [cmp x z] >= 0
+
+ When [sort] returns, [a] contains the same elements as before,
+ reordered in such a way that for all i and j valid indices of [a] :
+ - [cmp a.(i) a.(j)] >= 0 if and only if i >= j
+ *)
+
val stable_sort : cmp:(float -> float -> int) -> t -> unit
+ (** Same as {!sort}, but the sorting algorithm is stable (i.e.
+ elements that compare equal are kept in their original order) and
+ not guaranteed to run in constant heap space.
+
+ The current implementation uses Merge Sort. It uses a temporary
+ floatarray of length [n/2], where [n] is the length of the floatarray.
+ It is usually faster than the current implementation of {!sort}. *)
+
val fast_sort : cmp:(float -> float -> int) -> t -> unit
+ (** Same as {!sort} or {!stable_sort}, whichever is faster
+ on typical input. *)
+
+ (** {2 Iterators} *)
+
val to_seq : t -> float Seq.t
+ (** Iterate on the floatarray, in increasing order. Modifications of the
+ floatarray during iteration will be reflected in the iterator. *)
+
val to_seqi : t -> (int * float) Seq.t
+ (** Iterate on the floatarray, in increasing order, yielding indices along
+ elements. Modifications of the floatarray during iteration will be
+ reflected in the iterator. *)
+
val of_seq : float Seq.t -> t
+ (** Create an array from the generator. *)
+
+
val map_to_array : f:(float -> 'a) -> t -> 'a array
+ (** [map_to_array ~f a] applies function [f] to all the elements of [a],
+ and builds an array with the results returned by [f]:
+ [[| f a.(0); f a.(1); ...; f a.(length a - 1) |]]. *)
+
val map_from_array : f:('a -> float) -> 'a array -> t
+ (** [map_from_array ~f a] applies function [f] to all the elements of [a],
+ and builds a floatarray with the results returned by [f]. *)
+
+ (**/**)
+
+ (** {2 Undocumented functions} *)
(* These functions are for system use only. Do not call directly. *)
external unsafe_get : t -> int -> float = "%floatarray_unsafe_get"
external unsafe_set : t -> int -> float -> unit = "%floatarray_unsafe_set"
+
end
+(** Float arrays with packed representation (labeled functions). *)
pp_sep ppf ();
pp_print_list ~pp_sep pp_v ppf vs
+(* To format a sequence *)
+let rec pp_print_seq_in ~pp_sep pp_v ppf seq =
+ match seq () with
+ | Seq.Nil -> ()
+ | Seq.Cons (v, seq) ->
+ pp_sep ppf ();
+ pp_v ppf v;
+ pp_print_seq_in ~pp_sep pp_v ppf seq
+
+let pp_print_seq ?(pp_sep = pp_print_cut) pp_v ppf seq =
+ match seq () with
+ | Seq.Nil -> ()
+ | Seq.Cons (v, seq) ->
+ pp_v ppf v;
+ pp_print_seq_in ~pp_sep pp_v ppf seq
+
(* To format free-flowing text *)
let pp_print_text ppf s =
let len = String.length s in
out_flush : unit -> unit;
out_newline : unit -> unit;
out_spaces : int -> unit;
- out_indent : int -> unit;
+ out_indent : int -> unit;(** @since 4.06.0 *)
}
(** The set of output functions specific to a formatter:
- the [out_string] function performs all the pretty-printer string output.
@since 4.02.0
*)
+val pp_print_seq:
+ ?pp_sep:(formatter -> unit -> unit) ->
+ (formatter -> 'a -> unit) -> (formatter -> 'a Seq.t -> unit)
+(** [pp_print_seq ?pp_sep pp_v ppf s] prints items of sequence [s],
+ using [pp_v] to print each item, and calling [pp_sep]
+ between items ([pp_sep] defaults to {!pp_print_cut}.
+ Does nothing on empty sequences.
+
+ This function does not terminate on infinite sequences.
+
+ @since 4.12
+*)
+
val pp_print_text : formatter -> string -> unit
(** [pp_print_text ppf s] prints [s] with spaces and newlines respectively
printed using {!pp_print_space} and {!pp_force_newline}.
compactions : int;
top_heap_words : int;
stack_size : int;
+ forced_major_collections: int;
}
type control = {
let print_stat c =
let st = stat () in
- fprintf c "minor_collections: %d\n" st.minor_collections;
- fprintf c "major_collections: %d\n" st.major_collections;
- fprintf c "compactions: %d\n" st.compactions;
+ fprintf c "minor_collections: %d\n" st.minor_collections;
+ fprintf c "major_collections: %d\n" st.major_collections;
+ fprintf c "compactions: %d\n" st.compactions;
+ fprintf c "forced_major_collections: %d\n" st.forced_major_collections;
fprintf c "\n";
let l1 = String.length (sprintf "%.0f" st.minor_words) in
fprintf c "minor_words: %*.0f\n" l1 st.minor_words;
module Memprof =
struct
+ type allocation_source = Normal | Marshal | Custom
type allocation =
{ n_samples : int;
size : int;
- unmarshalled : bool;
+ source : allocation_source;
callstack : Printexc.raw_backtrace }
type ('minor, 'major) tracker = {
stack_size: int;
(** 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 *)
}
(** The memory management counters are returned in a [stat] record.
(** This value controls the GC messages on standard error output.
It is a sum of some of the following flags, to print messages
on the corresponding events:
- - [0x001] Start of major GC cycle.
+ - [0x001] Start and end of major GC cycle.
- [0x002] Minor collection and major GC slice.
- [0x004] Growing and shrinking of the heap.
- [0x008] Resizing of stacks and memory manager tables.
notice. *)
module Memprof :
sig
+ type allocation_source = Normal | Marshal | Custom
type allocation = private
{ n_samples : int;
(** The number of samples in this block (>= 1). *)
size : int;
(** The size of the block, in words, excluding the header. *)
- unmarshalled : bool;
- (** Whether the block comes from unmarshalling. *)
+ source : allocation_source;
+ (** The type of the allocation. *)
callstack : Printexc.raw_backtrace
(** The callstack for the allocation. *)
to keep for minor blocks, and ['major] the type of metadata
for major blocks.
+ When using threads, it is guaranteed that allocation callbacks are
+ always run in the thread where the allocation takes place.
+
If an allocation-tracking or promotion-tracking function returns [None],
memprof stops tracking the corresponding value.
*)
over their lifetime in the minor and major heap.
Sampling is temporarily disabled when calling a callback
- for the current thread. So they do not need to be reentrant if
+ for the current thread. So they do not need to be re-entrant if
the program is single-threaded. However, if threads are used,
it is possible that a context switch occurs during a callback,
- in this case the callback functions must be reentrant.
+ in this case the callback functions must be re-entrant.
Note that the callback can be postponed slightly after the
actual event. The callstack passed to the callback is always
- accurate, but the program state may have evolved.
-
- Calling [Thread.exit] in a callback is currently unsafe and can
- result in undefined behavior. *)
+ accurate, but the program state may have evolved. *)
val stop : unit -> unit
(** Stop the sampling. Fails if sampling is not active.
- This function does not allocate memory, but tries to run the
- postponed callbacks for already allocated memory blocks (of
- course, these callbacks may allocate).
+ This function does not allocate memory.
- All the already tracked blocks are discarded.
+ All the already tracked blocks are discarded. If there are
+ pending postponed callbacks, they may be discarded.
Calling [stop] when a callback is running can lead to
callbacks not being called even though some events happened. *)
Example: a lexer suitable for a desk calculator is obtained by
- {[ let lexer = make_lexer ["+";"-";"*";"/";"let";"="; "("; ")"] ]}
+{[ let lexer = make_lexer ["+"; "-"; "*"; "/"; "let"; "="; "("; ")"]]}
The associated parser would be a function from [token stream]
to, for instance, [int], and would have rules such as:
{[
- let rec parse_expr = parser
- | [< n1 = parse_atom; n2 = parse_remainder n1 >] -> n2
- and parse_atom = parser
- | [< 'Int n >] -> n
- | [< 'Kwd "("; n = parse_expr; 'Kwd ")" >] -> n
- and parse_remainder n1 = parser
- | [< 'Kwd "+"; n2 = parse_expr >] -> n1+n2
- | [< >] -> n1
+ let rec parse_expr = parser
+ | [< n1 = parse_atom; n2 = parse_remainder n1 >] -> n2
+ and parse_atom = parser
+ | [< 'Int n >] -> n
+ | [< 'Kwd "("; n = parse_expr; 'Kwd ")" >] -> n
+ and parse_remainder n1 = parser
+ | [< 'Kwd "+"; n2 = parse_expr >] -> n1 + n2
+ | [< >] -> n1
]}
One should notice that the use of the [parser] keyword and associated
let length h = h.size
+let insert_all_buckets indexfun inplace odata ndata =
+ let nsize = Array.length ndata in
+ let ndata_tail = Array.make nsize Empty in
+ let rec insert_bucket = function
+ | Empty -> ()
+ | Cons {key; data; next} as cell ->
+ let cell =
+ if inplace then cell
+ else Cons {key; data; next = Empty}
+ in
+ let nidx = indexfun key in
+ begin match ndata_tail.(nidx) with
+ | Empty -> ndata.(nidx) <- cell;
+ | Cons tail -> tail.next <- cell;
+ end;
+ ndata_tail.(nidx) <- cell;
+ insert_bucket next
+ in
+ for i = 0 to Array.length odata - 1 do
+ insert_bucket odata.(i)
+ done;
+ if inplace then
+ for i = 0 to nsize - 1 do
+ match ndata_tail.(i) with
+ | Empty -> ()
+ | Cons tail -> tail.next <- Empty
+ done
+
let resize indexfun h =
let odata = h.data in
let osize = Array.length odata in
let nsize = osize * 2 in
if nsize < Sys.max_array_length then begin
let ndata = Array.make nsize Empty in
- let ndata_tail = Array.make nsize Empty in
let inplace = not (ongoing_traversal h) in
h.data <- ndata; (* so that indexfun sees the new bucket count *)
- let rec insert_bucket = function
- | Empty -> ()
- | Cons {key; data; next} as cell ->
- let cell =
- if inplace then cell
- else Cons {key; data; next = Empty}
- in
- let nidx = indexfun h key in
- begin match ndata_tail.(nidx) with
- | Empty -> ndata.(nidx) <- cell;
- | Cons tail -> tail.next <- cell;
- end;
- ndata_tail.(nidx) <- cell;
- insert_bucket next
- in
- for i = 0 to osize - 1 do
- insert_bucket odata.(i)
- done;
- if inplace then
- for i = 0 to nsize - 1 do
- match ndata_tail.(i) with
- | Empty -> ()
- | Cons tail -> tail.next <- Empty
- done;
+ insert_all_buckets (indexfun h) inplace odata ndata
end
let iter f h =
try
for i = 0 to Array.length d - 1 do
filter_map_inplace_bucket f h i Empty h.data.(i)
- done
+ done;
+ if not old_trav then flip_ongoing_traversal h
with exn when not old_trav ->
flip_ongoing_traversal h;
raise exn
module type S =
sig
type key
- type 'a t
+ type !'a t
val create: int -> 'a t
val clear : 'a t -> unit
val reset : 'a t -> unit
module type SeededS =
sig
type key
- type 'a t
+ type !'a t
val create : ?random:bool -> int -> 'a t
val clear : 'a t -> unit
val reset : 'a t -> unit
external seeded_hash_param :
int -> int -> int -> 'a -> int = "caml_hash" [@@noalloc]
-external old_hash_param :
- int -> int -> 'a -> int = "caml_hash_univ_param" [@@noalloc]
let hash x = seeded_hash_param 10 100 0 x
let hash_param n1 n2 x = seeded_hash_param n1 n2 0 x
let seeded_hash seed x = seeded_hash_param 10 100 seed x
let key_index h key =
- (* compatibility with old hash tables *)
- if Obj.size (Obj.repr h) >= 3
+ if Obj.size (Obj.repr h) >= 4
then (seeded_hash_param 10 100 h.seed key) land (Array.length h.data - 1)
- else (old_hash_param 10 100 key) mod (Array.length h.data)
+ else invalid_arg "Hashtbl: unsupported hash table format"
let add h key data =
let i = key_index h key in
let tbl = create 16 in
replace_seq tbl i;
tbl
+
+let rebuild ?(random = !randomized) h =
+ let s = power_2_above 16 (Array.length h.data) in
+ let seed =
+ if random then Random.State.bits (Lazy.force prng)
+ else if Obj.size (Obj.repr h) >= 4 then h.seed
+ else 0 in
+ let h' = {
+ size = h.size;
+ data = Array.make s Empty;
+ seed = seed;
+ initial_size = if Obj.size (Obj.repr h) >= 4 then h.initial_size else s
+ } in
+ insert_all_buckets (key_index h') false h.data h'.data;
+ h'
(* *)
(**************************************************************************)
+(* NOTE: If this file is hashtbl.mli, do not edit it directly! Instead,
+ edit templates/hashtbl.template.mli and run tools/sync_stdlib_docs *)
+
(** Hash tables and hash functions.
Hash tables are hashed association tables, with in-place modification.
(** {1 Generic interface} *)
-type ('a, 'b) t
+type (!'a, !'b) t
(** The type of hash tables from type ['a] to type ['b]. *)
-val create : ?random:bool -> int -> ('a, 'b) t
+val create : ?random: (* thwart tools/sync_stdlib_docs *) bool ->
+ int -> ('a, 'b) t
(** [Hashtbl.create n] creates a new, empty hash table, with
initial size [n]. For best results, [n] should be on the
order of the expected number of elements that will be in
the table. The table grows as needed, so [n] is just an
initial guess.
- The optional [random] parameter (a boolean) controls whether
+ The optional [~][random] parameter (a boolean) controls whether
the internal organization of the hash table is randomized at each
execution of [Hashtbl.create] or deterministic over all executions.
- A hash table that is created with [~random:false] uses a
- fixed hash function ({!Hashtbl.hash}) to distribute keys among
+ A hash table that is created with [~][random] set to [false] uses a
+ fixed hash function ({!hash}) to distribute keys among
buckets. As a consequence, collisions between keys happen
deterministically. In Web-facing applications or other
security-sensitive applications, the deterministic collision
denial-of-service attack: the attacker sends input crafted to
create many collisions in the table, slowing the application down.
- A hash table that is created with [~random:true] uses the seeded
- hash function {!Hashtbl.seeded_hash} with a seed that is randomly
- chosen at hash table creation time. In effect, the hash function
- used is randomly selected among [2^{30}] different hash functions.
- All these hash functions have different collision patterns,
- rendering ineffective the denial-of-service attack described above.
- However, because of randomization, enumerating all elements of the
- hash table using {!Hashtbl.fold} or {!Hashtbl.iter} is no longer
- deterministic: elements are enumerated in different orders at
- different runs of the program.
-
- If no [~random] parameter is given, hash tables are created
+ A hash table that is created with [~][random] set to [true] uses the seeded
+ hash function {!seeded_hash} with a seed that is randomly chosen at hash
+ table creation time. In effect, the hash function used is randomly
+ selected among [2^{30}] different hash functions. All these hash
+ functions have different collision patterns, rendering ineffective the
+ denial-of-service attack described above. However, because of
+ randomization, enumerating all elements of the hash table using {!fold}
+ or {!iter} is no longer deterministic: elements are enumerated in
+ different orders at different runs of the program.
+
+ If no [~][random] parameter is given, hash tables are created
in non-random mode by default. This default can be changed
- either programmatically by calling {!Hashtbl.randomize} or by
+ either programmatically by calling {!randomize} or by
setting the [R] flag in the [OCAMLRUNPARAM] environment variable.
- @before 4.00.0 the [random] parameter was not present and all
+ @before 4.00.0 the [~][random] parameter was not present and all
hash tables were created in non-randomized mode. *)
val clear : ('a, 'b) t -> unit
(** Return a copy of the given hashtable. *)
val add : ('a, 'b) t -> 'a -> 'b -> unit
-(** [Hashtbl.add tbl x y] adds a binding of [x] to [y] in table [tbl].
- Previous bindings for [x] are not removed, but simply
- hidden. That is, after performing {!Hashtbl.remove}[ tbl x],
- the previous binding for [x], if any, is restored.
+(** [Hashtbl.add tbl key data] adds a binding of [key] to [data]
+ in table [tbl].
+ Previous bindings for [key] are not removed, but simply
+ hidden. That is, after performing {!remove}[ tbl key],
+ the previous binding for [key], if any, is restored.
(Same behavior as with association lists.) *)
val find : ('a, 'b) t -> 'a -> 'b
It does nothing if [x] is not bound in [tbl]. *)
val replace : ('a, 'b) t -> 'a -> 'b -> unit
-(** [Hashtbl.replace tbl x y] replaces the current binding of [x]
- in [tbl] by a binding of [x] to [y]. If [x] is unbound in [tbl],
- a binding of [x] to [y] is added to [tbl].
- This is functionally equivalent to {!Hashtbl.remove}[ tbl x]
- followed by {!Hashtbl.add}[ tbl x y]. *)
+(** [Hashtbl.replace tbl key data] replaces the current binding of [key]
+ in [tbl] by a binding of [key] to [data]. If [key] is unbound in [tbl],
+ a binding of [key] to [data] is added to [tbl].
+ This is functionally equivalent to {!remove}[ tbl key]
+ followed by {!add}[ tbl key data]. *)
val iter : ('a -> 'b -> unit) -> ('a, 'b) t -> unit
(** [Hashtbl.iter f tbl] applies [f] to all bindings in table [tbl].
by [f] during the iteration.
*)
-val filter_map_inplace: ('a -> 'b -> 'b option) -> ('a, 'b) t -> unit
+val filter_map_inplace: ('a -> 'b -> 'b option) -> ('a, 'b) t ->
+ unit
(** [Hashtbl.filter_map_inplace f tbl] applies [f] to all bindings in
table [tbl] and update each binding depending on the result of
[f]. If [f] returns [None], the binding is discarded. If it
returns [Some new_val], the binding is update to associate the key
to [new_val].
- Other comments for {!Hashtbl.iter} apply as well.
+ Other comments for {!iter} apply as well.
@since 4.03.0 *)
val fold : ('a -> 'b -> 'c -> 'c) -> ('a, 'b) t -> 'c -> 'c
val randomize : unit -> unit
(** After a call to [Hashtbl.randomize()], hash tables are created in
- randomized mode by default: {!Hashtbl.create} returns randomized
+ randomized mode by default: {!create} returns randomized
hash tables, unless the [~random:false] optional parameter is given.
The same effect can be achieved by setting the [R] parameter in
the [OCAMLRUNPARAM] environment variable.
It is recommended that applications or Web frameworks that need to
protect themselves against the denial-of-service attack described
- in {!Hashtbl.create} call [Hashtbl.randomize()] at initialization
+ in {!create} call [Hashtbl.randomize()] at initialization
time.
Note that once [Hashtbl.randomize()] was called, there is no way
- to revert to the non-randomized default behavior of {!Hashtbl.create}.
+ to revert to the non-randomized default behavior of {!create}.
This is intentional. Non-randomized hash tables can still be
created using [Hashtbl.create ~random:false].
@since 4.00.0 *)
val is_randomized : unit -> bool
-(** return if the tables are currently created in randomized mode by default
-
+(** Return [true] if the tables are currently created in randomized mode
+ by default, [false] otherwise.
@since 4.03.0 *)
+val rebuild : ?random (* thwart tools/sync_stdlib_docs *) :bool ->
+ ('a, 'b) t -> ('a, 'b) t
+(** Return a copy of the given hashtable. Unlike {!copy},
+ {!rebuild}[ h] re-hashes all the (key, value) entries of
+ the original table [h]. The returned hash table is randomized if
+ [h] was randomized, or the optional [random] parameter is true, or
+ if the default is to create randomized hash tables; see
+ {!create} for more information.
+
+ {!rebuild} can safely be used to import a hash table built
+ by an old version of the {!Hashtbl} module, then marshaled to
+ persistent storage. After unmarshaling, apply {!rebuild}
+ to produce a hash table for the current version of the {!Hashtbl}
+ module.
+
+ @since 4.12.0 *)
+
(** @since 4.00.0 *)
type statistics = {
num_bindings: int;
(** Number of bindings present in the table.
- Same value as returned by {!Hashtbl.length}. *)
+ Same value as returned by {!length}. *)
num_buckets: int;
(** Number of buckets in the table. *)
max_bucket_length: int;
as computed by [hash].
Examples: suitable ([equal], [hash]) pairs for arbitrary key
types include
-- ([(=)], {!Hashtbl.hash}) for comparing objects by structure
+- ([(=)], {!hash}) for comparing objects by structure
(provided objects do not contain floats)
-- ([(fun x y -> compare x y = 0)], {!Hashtbl.hash})
+- ([(fun x y -> compare x y = 0)], {!hash})
for comparing objects by structure
and handling {!Stdlib.nan} correctly
-- ([(==)], {!Hashtbl.hash}) for comparing objects by physical
+- ([(==)], {!hash}) for comparing objects by physical
equality (e.g. for mutable or cyclic objects). *)
end
-(** The input signature of the functor {!Hashtbl.Make}. *)
+(** The input signature of the functor {!Make}. *)
module type S =
sig
type key
- type 'a t
+ type !'a t
val create : int -> 'a t
val clear : 'a t -> unit
val reset : 'a t -> unit (** @since 4.00.0 *)
val replace : 'a t -> key -> 'a -> unit
val mem : 'a t -> key -> bool
val iter : (key -> 'a -> unit) -> 'a t -> unit
- val filter_map_inplace: (key -> 'a -> 'a option) -> 'a t -> unit
+ val filter_map_inplace: (key -> 'a -> 'a option) -> 'a t ->
+ unit
(** @since 4.03.0 *)
val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
val of_seq : (key * 'a) Seq.t -> 'a t
(** @since 4.07 *)
end
-(** The output signature of the functor {!Hashtbl.Make}. *)
+(** The output signature of the functor {!Make}. *)
module Make (H : HashedType) : S with type key = H.t
(** Functor building an implementation of the hashtable structure.
(** 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 {!Hashtbl.seeded_hash}
+ A suitable choice for [hash] is the function {!seeded_hash}
below. *)
end
-(** The input signature of the functor {!Hashtbl.MakeSeeded}.
+(** The input signature of the functor {!MakeSeeded}.
@since 4.00.0 *)
module type SeededS =
sig
type key
- type 'a t
- val create : ?random:bool -> int -> 'a t
+ 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 replace : 'a t -> key -> 'a -> unit
val mem : 'a t -> key -> bool
val iter : (key -> 'a -> unit) -> 'a t -> unit
- val filter_map_inplace: (key -> 'a -> 'a option) -> 'a t -> unit
+ val filter_map_inplace: (key -> 'a -> 'a option) -> 'a t ->
+ unit
(** @since 4.03.0 *)
val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
val of_seq : (key * 'a) Seq.t -> 'a t
(** @since 4.07 *)
end
-(** The output signature of the functor {!Hashtbl.MakeSeeded}.
+(** The output signature of the functor {!MakeSeeded}.
@since 4.00.0 *)
module MakeSeeded (H : SeededHashedType) : SeededS with type key = H.t
interface, but use the seeded hashing and equality functions
specified in the functor argument [H] instead of generic
equality and hashing. The [create] operation of the
- result structure supports the [~random] optional parameter
+ result structure supports the [~][random] optional parameter
and returns randomized hash tables if [~random:true] is passed
or if randomization is globally on (see {!Hashtbl.randomize}).
@since 4.00.0 *)
Moreover, [hash] always terminates, even on cyclic structures. *)
val seeded_hash : int -> 'a -> int
-(** A variant of {!Hashtbl.hash} that is further parameterized by
+(** A variant of {!hash} that is further parameterized by
an integer seed.
@since 4.00.0 *)
and therefore collisions are less likely to happen. However,
hashing takes longer. The parameters [meaningful] and [total]
govern the tradeoff between accuracy and speed. As default
- choices, {!Hashtbl.hash} and {!Hashtbl.seeded_hash} take
+ choices, {!hash} and {!seeded_hash} take
[meaningful = 10] and [total = 100]. *)
val seeded_hash_param : int -> int -> int -> 'a -> int
-(** A variant of {!Hashtbl.hash_param} that is further parameterized by
+(** A variant of {!hash_param} that is further parameterized by
an integer seed. Usage:
[Hashtbl.seeded_hash_param meaningful total seed x].
@since 4.00.0 *)
(** {1:preds Predicates and comparisons} *)
val equal : int -> int -> bool
-(** [equal x y] is [true] iff [x = y]. *)
+(** [equal x y] is [true] if and only if [x = y]. *)
val compare : int -> int -> int
(** [compare x y] is {!Stdlib.compare}[ x y] but more efficient. *)
| x :: l -> if p x then part (x :: yes) no l else part yes (x :: no) l in
part [] [] l
+let partition_map p l =
+ let rec part left right = function
+ | [] -> (rev left, rev right)
+ | x :: l ->
+ begin match p x with
+ | Either.Left v -> part (v :: left) right l
+ | Either.Right v -> part left (v :: right) l
+ end
+ in
+ part [] [] l
+
let rec split = function
[] -> ([], [])
| (x,y)::l ->
compare_length_with l (n-1)
;;
+(** {1 Comparison} *)
+
+(* Note: we are *not* shortcutting the list by using
+ [List.compare_lengths] first; this may be slower on long lists
+ immediately start with distinct elements. It is also incorrect for
+ [compare] below, and it is better (principle of least surprise) to
+ use the same approach for both functions. *)
+let rec equal eq l1 l2 =
+ match l1, l2 with
+ | [], [] -> true
+ | [], _::_ | _::_, [] -> false
+ | a1::l1, a2::l2 -> eq a1 a2 && equal eq l1 l2
+
+let rec compare cmp l1 l2 =
+ match l1, l2 with
+ | [], [] -> 0
+ | [], _::_ -> -1
+ | _::_, [] -> 1
+ | a1::l1, a2::l2 ->
+ let c = cmp a1 a2 in
+ if c <> 0 then c
+ else compare cmp l1 l2
+
(** {1 Iterators} *)
let to_seq l =
(* *)
(**************************************************************************)
+(* NOTE:
+ If this file is listLabels.mli, run tools/sync_stdlib_docs after editing it
+ to generate list.mli.
+
+ If this file is list.mli, do not edit it directly -- edit
+ listLabels.mli instead.
+ *)
+
(** List operations.
Some functions are flagged as not tail-recursive. A tail-recursive
The above considerations can usually be ignored if your lists are not
longer than about 10000 elements.
-*)
+
+ The labeled version of this module can be used as described in the
+ {!StdLabels} module.
+ *)
type 'a t = 'a list = [] | (::) of 'a * 'a list (**)
(** An alias for the type of lists. *)
val compare_lengths : 'a list -> 'b list -> int
(** Compare the lengths of two lists. [compare_lengths l1 l2] is
equivalent to [compare (length l1) (length l2)], except that
- the computation stops after itering on the shortest list.
+ the computation stops after reaching the end of the shortest list.
@since 4.05.0
*)
val compare_length_with : 'a list -> int -> int
-(** Compare the length of a list to an integer. [compare_length_with l n] is
- equivalent to [compare (length l) n], except that
- the computation stops after at most [n] iterations on the list.
+(** Compare the length of a list to an integer. [compare_length_with l len] is
+ equivalent to [compare (length l) len], except that the computation stops
+ after at most [len] iterations on the list.
@since 4.05.0
-*)
+ *)
val cons : 'a -> 'a list -> 'a list
(** [cons x xs] is [x :: xs]
- @since 4.03.0
-*)
+ @since 4.03.0 (4.05.0 in ListLabels)
+ *)
val hd : 'a list -> 'a
(** Return the first element of the given list.
- @raise Failure if the list is empty. *)
+ @raise Failure if the list is empty.
+ *)
val tl : 'a list -> 'a list
(** Return the given list without its first element.
- @raise Failure if the list is empty. *)
+ @raise Failure if the list is empty.
+ *)
-val nth: 'a list -> int -> 'a
+val nth : 'a list -> int -> 'a
(** Return the [n]-th element of the given list.
The first element (head of the list) is at position 0.
@raise Failure if the list is too short.
- @raise Invalid_argument if [n] is negative. *)
+ @raise Invalid_argument if [n] is negative.
+ *)
-val nth_opt: 'a list -> int -> 'a option
+val nth_opt : 'a list -> int -> 'a option
(** Return the [n]-th element of the given list.
The first element (head of the list) is at position 0.
Return [None] if the list is too short.
@raise Invalid_argument if [n] is negative.
@since 4.05
-*)
+ *)
val rev : 'a list -> 'a list
(** List reversal. *)
val init : int -> (int -> 'a) -> 'a list
-(** [List.init len f] is [[f 0; f 1; ...; f (len-1)]], evaluated left to right.
-
- @raise Invalid_argument if len < 0.
+(** [init len f] is [f 0; f 1; ...; f (len-1)], evaluated left to right.
+ @raise Invalid_argument if [len < 0].
@since 4.06.0
-*)
+ *)
val append : 'a list -> 'a list -> 'a list
-(** Concatenate two lists. Same as the infix operator [@].
- Not tail-recursive (length of the first argument). *)
+(** Concatenate two lists. Same function as the infix operator [@].
+ Not tail-recursive (length of the first argument). The [@]
+ operator is not tail-recursive either.
+ *)
val rev_append : 'a list -> 'a list -> 'a list
-(** [List.rev_append l1 l2] reverses [l1] and concatenates it to [l2].
- This is equivalent to {!List.rev}[ l1 @ l2], but [rev_append] is
- tail-recursive and more efficient. *)
+(** [rev_append l1 l2] reverses [l1] and concatenates it with [l2].
+ This is equivalent to [(]{!rev}[ l1) @ l2], but [rev_append] is
+ tail-recursive and more efficient.
+ *)
val concat : 'a list list -> 'a list
-(** Concatenate a list of lists. The elements of the argument are all
+(** Concatenate a list of lists. The elements of the argument are all
concatenated together (in the same order) to give the result.
Not tail-recursive
- (length of the argument + length of the longest sub-list). *)
+ (length of the argument + length of the longest sub-list).
+ *)
val flatten : 'a list list -> 'a list
-(** An alias for [concat]. *)
+(** Same as {!concat}. Not tail-recursive
+ (length of the argument + length of the longest sub-list).
+ *)
+
+
+(** {1 Comparison} *)
+
+val equal : ('a -> 'a -> bool) -> 'a list -> 'a list -> bool
+(** [equal eq [a1; ...; an] [b1; ..; bm]] holds when
+ the two input lists have the same length, and for each
+ pair of elements [ai], [bi] at the same position we have
+ [eq ai bi].
+ Note: the [eq] function may be called even if the
+ lists have different length. If you know your equality
+ function is costly, you may want to check {!compare_lengths}
+ first.
+
+ @since 4.12.0
+*)
+
+val compare : ('a -> 'a -> int) -> 'a list -> 'a list -> int
+(** [compare cmp [a1; ...; an] [b1; ...; bm]] performs
+ a lexicographic comparison of the two input lists,
+ using the same ['a -> 'a -> int] interface as {!Stdlib.compare}:
+
+ - [a1 :: l1] is smaller than [a2 :: l2] (negative result)
+ if [a1] is smaller than [a2], or if they are equal (0 result)
+ and [l1] is smaller than [l2]
+ - the empty list [[]] is strictly smaller than non-empty lists
+
+ Note: the [cmp] function will be called even if the lists have
+ different lengths.
+
+ @since 4.12.0
+*)
(** {1 Iterators} *)
val iter : ('a -> unit) -> 'a list -> unit
-(** [List.iter f [a1; ...; an]] applies function [f] in turn to
+(** [iter f [a1; ...; an]] applies function [f] in turn to
[a1; ...; an]. It is equivalent to
- [begin f a1; f a2; ...; f an; () end]. *)
+ [begin f a1; f a2; ...; f an; () end].
+ *)
val iteri : (int -> 'a -> unit) -> 'a list -> unit
-(** Same as {!List.iter}, but the function is applied to the index of
+(** Same as {!iter}, but the function is applied to the index of
the element as first argument (counting from 0), and the element
itself as second argument.
@since 4.00.0
-*)
+ *)
val map : ('a -> 'b) -> 'a list -> 'b list
-(** [List.map f [a1; ...; an]] applies function [f] to [a1, ..., an],
+(** [map f [a1; ...; an]] applies function [f] to [a1, ..., an],
and builds the list [[f a1; ...; f an]]
- with the results returned by [f]. Not tail-recursive. *)
+ with the results returned by [f]. Not tail-recursive.
+ *)
val mapi : (int -> 'a -> 'b) -> 'a list -> 'b list
-(** Same as {!List.map}, but the function is applied to the index of
+(** Same as {!map}, but the function is applied to the index of
the element as first argument (counting from 0), and the element
- itself as second argument. Not tail-recursive.
+ itself as second argument. Not tail-recursive.
@since 4.00.0
-*)
+ *)
val rev_map : ('a -> 'b) -> 'a list -> 'b list
-(** [List.rev_map f l] gives the same result as
- {!List.rev}[ (]{!List.map}[ f l)], but is tail-recursive and
- more efficient. *)
+(** [rev_map f l] gives the same result as
+ {!rev}[ (]{!map}[ f l)], but is tail-recursive and
+ more efficient.
+ *)
val filter_map : ('a -> 'b option) -> 'a list -> 'b list
(** [filter_map f l] applies [f] to every element of [l], filters
out the [None] elements and returns the list of the arguments of
the [Some] elements.
@since 4.08.0
-*)
+ *)
val concat_map : ('a -> 'b list) -> 'a list -> 'b list
-(** [List.concat_map f l] gives the same result as
- {!List.concat}[ (]{!List.map}[ f l)]. Tail-recursive.
-
+(** [concat_map f l] gives the same result as
+ {!concat}[ (]{!map}[ f l)]. Tail-recursive.
@since 4.10.0
*)
-val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
+val fold_left_map :
+ ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
(** [fold_left_map] is a combination of [fold_left] and [map] that threads an
- accumulator through calls to [f]
+ accumulator through calls to [f].
@since 4.11.0
*)
val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a
-(** [List.fold_left f a [b1; ...; bn]] is
- [f (... (f (f a b1) b2) ...) bn]. *)
+(** [fold_left f init [b1; ...; bn]] is
+ [f (... (f (f init b1) b2) ...) bn].
+ *)
val fold_right : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b
-(** [List.fold_right f [a1; ...; an] b] is
- [f a1 (f a2 (... (f an b) ...))]. Not tail-recursive. *)
+(** [fold_right f [a1; ...; an] init] is
+ [f a1 (f a2 (... (f an init) ...))]. Not tail-recursive.
+ *)
(** {1 Iterators on two lists} *)
val iter2 : ('a -> 'b -> unit) -> 'a list -> 'b list -> unit
-(** [List.iter2 f [a1; ...; an] [b1; ...; bn]] calls in turn
+(** [iter2 f [a1; ...; an] [b1; ...; bn]] calls in turn
[f a1 b1; ...; f an bn].
@raise Invalid_argument if the two lists are determined
- to have different lengths. *)
+ to have different lengths.
+ *)
val map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
-(** [List.map2 f [a1; ...; an] [b1; ...; bn]] is
+(** [map2 f [a1; ...; an] [b1; ...; bn]] is
[[f a1 b1; ...; f an bn]].
@raise Invalid_argument if the two lists are determined
- to have different lengths. Not tail-recursive. *)
+ to have different lengths. Not tail-recursive.
+ *)
val rev_map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
-(** [List.rev_map2 f l1 l2] gives the same result as
- {!List.rev}[ (]{!List.map2}[ f l1 l2)], but is tail-recursive and
- more efficient. *)
+(** [rev_map2 f l1 l2] gives the same result as
+ {!rev}[ (]{!map2}[ f l1 l2)], but is tail-recursive and
+ more efficient.
+ *)
-val fold_left2 : ('a -> 'b -> 'c -> 'a) -> 'a -> 'b list -> 'c list -> 'a
-(** [List.fold_left2 f a [b1; ...; bn] [c1; ...; cn]] is
- [f (... (f (f a b1 c1) b2 c2) ...) bn cn].
+val fold_left2 :
+ ('a -> 'b -> 'c -> 'a) -> 'a -> 'b list -> 'c list -> 'a
+(** [fold_left2 f init [a1; ...; an] [b1; ...; bn]] is
+ [f (... (f (f init a1 b1) a2 b2) ...) an bn].
@raise Invalid_argument if the two lists are determined
- to have different lengths. *)
+ to have different lengths.
+ *)
-val fold_right2 : ('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> 'c -> 'c
-(** [List.fold_right2 f [a1; ...; an] [b1; ...; bn] c] is
- [f a1 b1 (f a2 b2 (... (f an bn c) ...))].
+val fold_right2 :
+ ('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> 'c -> 'c
+(** [fold_right2 f [a1; ...; an] [b1; ...; bn] init] is
+ [f a1 b1 (f a2 b2 (... (f an bn init) ...))].
@raise Invalid_argument if the two lists are determined
- to have different lengths. Not tail-recursive. *)
+ to have different lengths. Not tail-recursive.
+ *)
(** {1 List scanning} *)
val for_all : ('a -> bool) -> 'a list -> bool
-(** [for_all p [a1; ...; an]] checks if all elements of the list
- satisfy the predicate [p]. That is, it returns
- [(p a1) && (p a2) && ... && (p an)] for a non-empty list and
- [true] if the list is empty. *)
+(** [for_all f [a1; ...; an]] checks if all elements of the list
+ satisfy the predicate [f]. That is, it returns
+ [(f a1) && (f a2) && ... && (f an)] for a non-empty list and
+ [true] if the list is empty.
+ *)
val exists : ('a -> bool) -> 'a list -> bool
-(** [exists p [a1; ...; an]] checks if at least one element of
- the list satisfies the predicate [p]. That is, it returns
- [(p a1) || (p a2) || ... || (p an)] for a non-empty list and
- [false] if the list is empty. *)
+(** [exists f [a1; ...; an]] checks if at least one element of
+ the list satisfies the predicate [f]. That is, it returns
+ [(f a1) || (f a2) || ... || (f an)] for a non-empty list and
+ [false] if the list is empty.
+ *)
val for_all2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool
-(** Same as {!List.for_all}, but for a two-argument predicate.
+(** Same as {!for_all}, but for a two-argument predicate.
@raise Invalid_argument if the two lists are determined
- to have different lengths. *)
+ to have different lengths.
+ *)
val exists2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool
-(** Same as {!List.exists}, but for a two-argument predicate.
+(** Same as {!exists}, but for a two-argument predicate.
@raise Invalid_argument if the two lists are determined
- to have different lengths. *)
+ to have different lengths.
+ *)
val mem : 'a -> 'a list -> bool
-(** [mem a l] is true if and only if [a] is equal
- to an element of [l]. *)
+(** [mem a set] is true if and only if [a] is equal
+ to an element of [set].
+ *)
val memq : 'a -> 'a list -> bool
-(** Same as {!List.mem}, but uses physical equality instead of structural
- equality to compare list elements. *)
+(** Same as {!mem}, but uses physical equality instead of structural
+ equality to compare list elements.
+ *)
(** {1 List searching} *)
val find : ('a -> bool) -> 'a list -> 'a
-(** [find p l] returns the first element of the list [l]
- that satisfies the predicate [p].
- @raise Not_found if there is no value that satisfies [p] in the
- list [l]. *)
-
-val find_opt: ('a -> bool) -> 'a list -> 'a option
-(** [find_opt p l] returns the first element of the list [l] that
- satisfies the predicate [p], or [None] if there is no value that
- satisfies [p] in the list [l].
- @since 4.05 *)
-
-val find_map: ('a -> 'b option) -> 'a list -> 'b option
+(** [find f l] returns the first element of the list [l]
+ that satisfies the predicate [f].
+ @raise Not_found if there is no value that satisfies [f] in the
+ list [l].
+ *)
+
+val find_opt : ('a -> bool) -> 'a list -> 'a option
+(** [find f l] returns the first element of the list [l]
+ that satisfies the predicate [f].
+ Returns [None] if there is no value that satisfies [f] in the
+ list [l].
+ @since 4.05
+ *)
+
+val find_map : ('a -> 'b option) -> 'a list -> 'b option
(** [find_map f l] applies [f] to the elements of [l] in order,
and returns the first result of the form [Some v], or [None]
if none exist.
*)
val filter : ('a -> bool) -> 'a list -> 'a list
-(** [filter p l] returns all the elements of the list [l]
- that satisfy the predicate [p]. The order of the elements
- in the input list is preserved. *)
+(** [filter f l] returns all the elements of the list [l]
+ that satisfy the predicate [f]. The order of the elements
+ in the input list is preserved.
+ *)
val find_all : ('a -> bool) -> 'a list -> 'a list
-(** [find_all] is another name for {!List.filter}. *)
+(** [find_all] is another name for {!filter}.
+ *)
val filteri : (int -> 'a -> bool) -> 'a list -> 'a list
-(** Same as {!List.filter}, but the predicate is applied to the index of
+(** Same as {!filter}, but the predicate is applied to the index of
the element as first argument (counting from 0), and the element
itself as second argument.
@since 4.11.0
*)
val partition : ('a -> bool) -> 'a list -> 'a list * 'a list
-(** [partition p l] returns a pair of lists [(l1, l2)], where
+(** [partition f l] returns a pair of lists [(l1, l2)], where
[l1] is the list of all the elements of [l] that
- satisfy the predicate [p], and [l2] is the list of all the
- elements of [l] that do not satisfy [p].
- The order of the elements in the input list is preserved. *)
+ satisfy the predicate [f], and [l2] is the list of all the
+ elements of [l] that do not satisfy [f].
+ The order of the elements in the input list is preserved.
+ *)
+
+val partition_map : ('a -> ('b, 'c) Either.t) -> 'a list -> 'b list * 'c list
+(** [partition_map f l] returns a pair of lists [(l1, l2)] such that,
+ for each element [x] of the input list [l]:
+ - if [f x] is [Left y1], then [y1] is in [l1], and
+ - if [f x] is [Right y2], then [y2] is in [l2].
+
+ The output elements are included in [l1] and [l2] in the same
+ relative order as the corresponding input elements in [l].
+
+ In particular, [partition_map (fun x -> if f x then Left x else Right x) l]
+ is equivalent to [partition f l].
+
+ @since 4.12.0
+*)
(** {1 Association lists} *)
[assoc a [ ...; (a,b); ...] = b]
if [(a,b)] is the leftmost binding of [a] in list [l].
@raise Not_found if there is no value associated with [a] in the
- list [l]. *)
+ list [l].
+ *)
-val assoc_opt: 'a -> ('a * 'b) list -> 'b option
+val assoc_opt : 'a -> ('a * 'b) list -> 'b option
(** [assoc_opt a l] returns the value associated with key [a] in the list of
- pairs [l]. That is,
- [assoc_opt a [ ...; (a,b); ...] = b]
- if [(a,b)] is the leftmost binding of [a] in list [l].
- Returns [None] if there is no value associated with [a] in the
- list [l].
- @since 4.05 *)
+ pairs [l]. That is,
+ [assoc_opt a [ ...; (a,b); ...] = Some b]
+ if [(a,b)] is the leftmost binding of [a] in list [l].
+ Returns [None] if there is no value associated with [a] in the
+ list [l].
+ @since 4.05
+ *)
val assq : 'a -> ('a * 'b) list -> 'b
-(** Same as {!List.assoc}, but uses physical equality instead of structural
- equality to compare keys. *)
+(** Same as {!assoc}, but uses physical equality instead of
+ structural equality to compare keys.
+ *)
val assq_opt : 'a -> ('a * 'b) list -> 'b option
-(** Same as {!List.assoc_opt}, but uses physical equality instead of structural
- equality to compare keys.
- @since 4.05 *)
+(** Same as {!assoc_opt}, but uses physical equality instead of
+ structural equality to compare keys.
+ @since 4.05.0
+ *)
val mem_assoc : 'a -> ('a * 'b) list -> bool
-(** Same as {!List.assoc}, but simply return true if a binding exists,
- and false if no bindings exist for the given key. *)
+(** Same as {!assoc}, but simply return [true] if a binding exists,
+ and [false] if no bindings exist for the given key.
+ *)
val mem_assq : 'a -> ('a * 'b) list -> bool
-(** Same as {!List.mem_assoc}, but uses physical equality instead of
- structural equality to compare keys. *)
+(** Same as {!mem_assoc}, but uses physical equality instead of
+ structural equality to compare keys.
+ *)
val remove_assoc : 'a -> ('a * 'b) list -> ('a * 'b) list
(** [remove_assoc a l] returns the list of
pairs [l] without the first pair with key [a], if any.
- Not tail-recursive. *)
+ Not tail-recursive.
+ *)
val remove_assq : 'a -> ('a * 'b) list -> ('a * 'b) list
-(** Same as {!List.remove_assoc}, but uses physical equality instead
- of structural equality to compare keys. Not tail-recursive. *)
+(** Same as {!remove_assoc}, but uses physical equality instead
+ of structural equality to compare keys. Not tail-recursive.
+ *)
(** {1 Lists of pairs} *)
(** Transform a list of pairs into a pair of lists:
[split [(a1,b1); ...; (an,bn)]] is [([a1; ...; an], [b1; ...; bn])].
Not tail-recursive.
-*)
+ *)
val combine : 'a list -> 'b list -> ('a * 'b) list
(** Transform a pair of lists into a list of pairs:
[combine [a1; ...; an] [b1; ...; bn]] is
[[(a1,b1); ...; (an,bn)]].
@raise Invalid_argument if the two lists
- have different lengths. Not tail-recursive. *)
+ have different lengths. Not tail-recursive.
+ *)
(** {1 Sorting} *)
val sort : ('a -> 'a -> int) -> 'a list -> 'a list
(** Sort a list in increasing order according to a comparison
- function. The comparison function must return 0 if its arguments
+ function. The comparison function must return 0 if its arguments
compare as equal, a positive integer if the first is greater,
and a negative integer if the first is smaller (see Array.sort for
- a complete specification). For example,
+ a complete specification). For example,
{!Stdlib.compare} is a suitable comparison function.
The resulting list is sorted in increasing order.
- [List.sort] is guaranteed to run in constant heap space
+ {!sort} is guaranteed to run in constant heap space
(in addition to the size of the result list) and logarithmic
stack space.
The current implementation uses Merge Sort. It runs in constant
heap space and logarithmic stack space.
-*)
+ *)
val stable_sort : ('a -> 'a -> int) -> 'a list -> 'a list
-(** Same as {!List.sort}, but the sorting algorithm is guaranteed to
+(** Same as {!sort}, but the sorting algorithm is guaranteed to
be stable (i.e. elements that compare equal are kept in their
- original order) .
+ original order).
The current implementation uses Merge Sort. It runs in constant
heap space and logarithmic stack space.
-*)
+ *)
val fast_sort : ('a -> 'a -> int) -> 'a list -> 'a list
-(** Same as {!List.sort} or {!List.stable_sort}, whichever is faster
- on typical input. *)
+(** Same as {!sort} or {!stable_sort}, whichever is
+ faster on typical input.
+ *)
val sort_uniq : ('a -> 'a -> int) -> 'a list -> 'a list
-(** Same as {!List.sort}, but also remove duplicates.
- @since 4.02.0 *)
+(** Same as {!sort}, but also remove duplicates.
+ @since 4.02.0 (4.03.0 in ListLabels)
+ *)
val merge : ('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
(** Merge two lists:
If several elements compare equal, the elements of [l1] will be
before the elements of [l2].
Not tail-recursive (sum of the lengths of the arguments).
-*)
+ *)
(** {1 Iterators} *)
val to_seq : 'a list -> 'a Seq.t
-(** Iterate on the list
- @since 4.07 *)
+(** Iterate on the list.
+ @since 4.07
+ *)
val of_seq : 'a Seq.t -> 'a list
-(** Create a list from the iterator
- @since 4.07 *)
+(** Create a list from the iterator.
+ @since 4.07
+ *)
(* *)
(**************************************************************************)
-type 'a t = 'a list = [] | (::) of 'a * 'a list (**)
-(** An alias for the type of lists.
+(* NOTE:
+ If this file is listLabels.mli, run tools/sync_stdlib_docs after editing it
+ to generate list.mli.
+
+ If this file is list.mli, do not edit it directly -- edit
+ listLabels.mli instead.
*)
(** List operations.
The above considerations can usually be ignored if your lists are not
longer than about 10000 elements.
- This module is intended to be used through {!StdLabels} which replaces
- {!Array}, {!Bytes}, {!List} and {!String} with their labeled counterparts.
-
- For example:
- {[
- open StdLabels
-
- let seq len = List.init ~f:(function i -> i) ~len
- ]}
+ The labeled version of this module can be used as described in the
+ {!StdLabels} module.
*)
-val length : 'a list -> int
-(** Return the length (number of elements) of the given list.
- *)
+type 'a t = 'a list = [] | (::) of 'a * 'a list (**)
+(** An alias for the type of lists. *)
-val hd : 'a list -> 'a
-(** Return the first element of the given list.
- @raise Failure if the list is empty.
- *)
+val length : 'a list -> int
+(** Return the length (number of elements) of the given list. *)
val compare_lengths : 'a list -> 'b list -> int
(** Compare the lengths of two lists. [compare_lengths l1 l2] is
equivalent to [compare (length l1) (length l2)], except that
- the computation stops after itering on the shortest list.
+ the computation stops after reaching the end of the shortest list.
@since 4.05.0
*)
val compare_length_with : 'a list -> len:int -> int
-(** Compare the length of a list to an integer. [compare_length_with l n] is
- equivalent to [compare (length l) n], except that
- the computation stops after at most [n] iterations on the list.
+(** Compare the length of a list to an integer. [compare_length_with l len] is
+ equivalent to [compare (length l) len], except that the computation stops
+ after at most [len] iterations on the list.
@since 4.05.0
*)
val cons : 'a -> 'a list -> 'a list
(** [cons x xs] is [x :: xs]
- @since 4.05.0
+ @since 4.03.0 (4.05.0 in ListLabels)
+ *)
+
+val hd : 'a list -> 'a
+(** Return the first element of the given list.
+ @raise Failure if the list is empty.
*)
val tl : 'a list -> 'a list
@raise Invalid_argument if [n] is negative.
*)
-val nth_opt: 'a list -> int -> 'a option
+val nth_opt : 'a list -> int -> 'a option
(** Return the [n]-th element of the given list.
The first element (head of the list) is at position 0.
Return [None] if the list is too short.
*)
val rev : 'a list -> 'a list
-(** List reversal.
- *)
+(** List reversal. *)
val init : len:int -> f:(int -> 'a) -> 'a list
-(** [List.init len f] is [f 0; f 1; ...; f (len-1)], evaluated left to right.
+(** [init ~len ~f] is [f 0; f 1; ...; f (len-1)], evaluated left to right.
@raise Invalid_argument if [len < 0].
@since 4.06.0
*)
val append : 'a list -> 'a list -> 'a list
-(** Catenate two lists. Same function as the infix operator [@].
+(** Concatenate two lists. Same function as the infix operator [@].
Not tail-recursive (length of the first argument). The [@]
operator is not tail-recursive either.
*)
val rev_append : 'a list -> 'a list -> 'a list
-(** [List.rev_append l1 l2] reverses [l1] and concatenates it with [l2].
- This is equivalent to [(]{!List.rev}[ l1) @ l2], but [rev_append] is
+(** [rev_append l1 l2] reverses [l1] and concatenates it with [l2].
+ This is equivalent to [(]{!rev}[ l1) @ l2], but [rev_append] is
tail-recursive and more efficient.
*)
*)
val flatten : 'a list list -> 'a list
-(** Same as [concat]. Not tail-recursive
+(** Same as {!concat}. Not tail-recursive
(length of the argument + length of the longest sub-list).
*)
+(** {1 Comparison} *)
+
+val equal : eq:('a -> 'a -> bool) -> 'a list -> 'a list -> bool
+(** [equal eq [a1; ...; an] [b1; ..; bm]] holds when
+ the two input lists have the same length, and for each
+ pair of elements [ai], [bi] at the same position we have
+ [eq ai bi].
+
+ Note: the [eq] function may be called even if the
+ lists have different length. If you know your equality
+ function is costly, you may want to check {!compare_lengths}
+ first.
+
+ @since 4.12.0
+*)
+
+val compare : cmp:('a -> 'a -> int) -> 'a list -> 'a list -> int
+(** [compare cmp [a1; ...; an] [b1; ...; bm]] performs
+ a lexicographic comparison of the two input lists,
+ using the same ['a -> 'a -> int] interface as {!Stdlib.compare}:
+
+ - [a1 :: l1] is smaller than [a2 :: l2] (negative result)
+ if [a1] is smaller than [a2], or if they are equal (0 result)
+ and [l1] is smaller than [l2]
+ - the empty list [[]] is strictly smaller than non-empty lists
+
+ Note: the [cmp] function will be called even if the lists have
+ different lengths.
+
+ @since 4.12.0
+*)
+
(** {1 Iterators} *)
val iter : f:('a -> unit) -> 'a list -> unit
-(** [List.iter f [a1; ...; an]] applies function [f] in turn to
+(** [iter ~f [a1; ...; an]] applies function [f] in turn to
[a1; ...; an]. It is equivalent to
[begin f a1; f a2; ...; f an; () end].
*)
val iteri : f:(int -> 'a -> unit) -> 'a list -> unit
-(** Same as {!List.iter}, but the function is applied to the index of
+(** Same as {!iter}, but the function is applied to the index of
the element as first argument (counting from 0), and the element
itself as second argument.
@since 4.00.0
*)
val map : f:('a -> 'b) -> 'a list -> 'b list
-(** [List.map f [a1; ...; an]] applies function [f] to [a1, ..., an],
+(** [map ~f [a1; ...; an]] applies function [f] to [a1, ..., an],
and builds the list [[f a1; ...; f an]]
with the results returned by [f]. Not tail-recursive.
*)
val mapi : f:(int -> 'a -> 'b) -> 'a list -> 'b list
-(** Same as {!List.map}, but the function is applied to the index of
+(** Same as {!map}, but the function is applied to the index of
the element as first argument (counting from 0), and the element
- itself as second argument.
+ itself as second argument. Not tail-recursive.
@since 4.00.0
*)
val rev_map : f:('a -> 'b) -> 'a list -> 'b list
-(** [List.rev_map f l] gives the same result as
- {!List.rev}[ (]{!List.map}[ f l)], but is tail-recursive and
+(** [rev_map ~f l] gives the same result as
+ {!rev}[ (]{!map}[ f l)], but is tail-recursive and
more efficient.
*)
val filter_map : f:('a -> 'b option) -> 'a list -> 'b list
-(** [filter_map f l] applies [f] to every element of [l], filters
+(** [filter_map ~f l] applies [f] to every element of [l], filters
out the [None] elements and returns the list of the arguments of
the [Some] elements.
@since 4.08.0
*)
val concat_map : f:('a -> 'b list) -> 'a list -> 'b list
-(** [List.concat_map f l] gives the same result as
- {!List.concat}[ (]{!List.map}[ f l)]. Tail-recursive.
-
+(** [concat_map ~f l] gives the same result as
+ {!concat}[ (]{!map}[ f l)]. Tail-recursive.
@since 4.10.0
*)
val fold_left_map :
f:('a -> 'b -> 'a * 'c) -> init:'a -> 'b list -> 'a * 'c list
-(** [fold_left_map] is a combination of [fold_left] and [map] hat threads an
- accumulator through calls to [f]
+(** [fold_left_map] is a combination of [fold_left] and [map] that threads an
+ accumulator through calls to [f].
@since 4.11.0
*)
val fold_left : f:('a -> 'b -> 'a) -> init:'a -> 'b list -> 'a
-(** [List.fold_left f a [b1; ...; bn]] is
- [f (... (f (f a b1) b2) ...) bn].
+(** [fold_left ~f ~init [b1; ...; bn]] is
+ [f (... (f (f init b1) b2) ...) bn].
*)
val fold_right : f:('a -> 'b -> 'b) -> 'a list -> init:'b -> 'b
-(** [List.fold_right f [a1; ...; an] b] is
- [f a1 (f a2 (... (f an b) ...))]. Not tail-recursive.
+(** [fold_right ~f [a1; ...; an] ~init] is
+ [f a1 (f a2 (... (f an init) ...))]. Not tail-recursive.
*)
val iter2 : f:('a -> 'b -> unit) -> 'a list -> 'b list -> unit
-(** [List.iter2 f [a1; ...; an] [b1; ...; bn]] calls in turn
+(** [iter2 ~f [a1; ...; an] [b1; ...; bn]] calls in turn
[f a1 b1; ...; f an bn].
@raise Invalid_argument if the two lists are determined
to have different lengths.
*)
val map2 : f:('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
-(** [List.map2 f [a1; ...; an] [b1; ...; bn]] is
+(** [map2 ~f [a1; ...; an] [b1; ...; bn]] is
[[f a1 b1; ...; f an bn]].
@raise Invalid_argument if the two lists are determined
to have different lengths. Not tail-recursive.
*)
val rev_map2 : f:('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
-(** [List.rev_map2 f l1 l2] gives the same result as
- {!List.rev}[ (]{!List.map2}[ f l1 l2)], but is tail-recursive and
+(** [rev_map2 ~f l1 l2] gives the same result as
+ {!rev}[ (]{!map2}[ f l1 l2)], but is tail-recursive and
more efficient.
*)
val fold_left2 :
f:('a -> 'b -> 'c -> 'a) -> init:'a -> 'b list -> 'c list -> 'a
-(** [List.fold_left2 f a [b1; ...; bn] [c1; ...; cn]] is
- [f (... (f (f a b1 c1) b2 c2) ...) bn cn].
+(** [fold_left2 ~f ~init [a1; ...; an] [b1; ...; bn]] is
+ [f (... (f (f init a1 b1) a2 b2) ...) an bn].
@raise Invalid_argument if the two lists are determined
to have different lengths.
*)
val fold_right2 :
f:('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> init:'c -> 'c
-(** [List.fold_right2 f [a1; ...; an] [b1; ...; bn] c] is
- [f a1 b1 (f a2 b2 (... (f an bn c) ...))].
+(** [fold_right2 ~f [a1; ...; an] [b1; ...; bn] ~init] is
+ [f a1 b1 (f a2 b2 (... (f an bn init) ...))].
@raise Invalid_argument if the two lists are determined
to have different lengths. Not tail-recursive.
*)
val for_all : f:('a -> bool) -> 'a list -> bool
-(** [for_all p [a1; ...; an]] checks if all elements of the list
- satisfy the predicate [p]. That is, it returns
- [(p a1) && (p a2) && ... && (p an)].
+(** [for_all ~f [a1; ...; an]] checks if all elements of the list
+ satisfy the predicate [f]. That is, it returns
+ [(f a1) && (f a2) && ... && (f an)] for a non-empty list and
+ [true] if the list is empty.
*)
val exists : f:('a -> bool) -> 'a list -> bool
-(** [exists p [a1; ...; an]] checks if at least one element of
- the list satisfies the predicate [p]. That is, it returns
- [(p a1) || (p a2) || ... || (p an)].
+(** [exists ~f [a1; ...; an]] checks if at least one element of
+ the list satisfies the predicate [f]. That is, it returns
+ [(f a1) || (f a2) || ... || (f an)] for a non-empty list and
+ [false] if the list is empty.
*)
val for_all2 : f:('a -> 'b -> bool) -> 'a list -> 'b list -> bool
-(** Same as {!List.for_all}, but for a two-argument predicate.
+(** Same as {!for_all}, but for a two-argument predicate.
@raise Invalid_argument if the two lists are determined
to have different lengths.
*)
val exists2 : f:('a -> 'b -> bool) -> 'a list -> 'b list -> bool
-(** Same as {!List.exists}, but for a two-argument predicate.
+(** Same as {!exists}, but for a two-argument predicate.
@raise Invalid_argument if the two lists are determined
to have different lengths.
*)
val mem : 'a -> set:'a list -> bool
-(** [mem a l] is true if and only if [a] is equal
- to an element of [l].
+(** [mem a ~set] is true if and only if [a] is equal
+ to an element of [set].
*)
val memq : 'a -> set:'a list -> bool
-(** Same as {!List.mem}, but uses physical equality instead of structural
+(** Same as {!mem}, but uses physical equality instead of structural
equality to compare list elements.
*)
val find : f:('a -> bool) -> 'a list -> 'a
-(** [find p l] returns the first element of the list [l]
- that satisfies the predicate [p].
- @raise Not_found if there is no value that satisfies [p] in the
+(** [find ~f l] returns the first element of the list [l]
+ that satisfies the predicate [f].
+ @raise Not_found if there is no value that satisfies [f] in the
list [l].
*)
-val find_opt: f:('a -> bool) -> 'a list -> 'a option
-(** [find p l] returns the first element of the list [l]
- that satisfies the predicate [p].
- Returns [None] if there is no value that satisfies [p] in the
+val find_opt : f:('a -> bool) -> 'a list -> 'a option
+(** [find ~f l] returns the first element of the list [l]
+ that satisfies the predicate [f].
+ Returns [None] if there is no value that satisfies [f] in the
list [l].
@since 4.05
*)
-val find_map: f:('a -> 'b option) -> 'a list -> 'b option
-(** [find_map f l] applies [f] to the elements of [l] in order,
+val find_map : f:('a -> 'b option) -> 'a list -> 'b option
+(** [find_map ~f l] applies [f] to the elements of [l] in order,
and returns the first result of the form [Some v], or [None]
if none exist.
@since 4.10.0
*)
val filter : f:('a -> bool) -> 'a list -> 'a list
-(** [filter p l] returns all the elements of the list [l]
- that satisfy the predicate [p]. The order of the elements
+(** [filter ~f l] returns all the elements of the list [l]
+ that satisfy the predicate [f]. The order of the elements
in the input list is preserved.
*)
val find_all : f:('a -> bool) -> 'a list -> 'a list
-(** [find_all] is another name for {!List.filter}.
+(** [find_all] is another name for {!filter}.
*)
val filteri : f:(int -> 'a -> bool) -> 'a list -> 'a list
-(** Same as {!List.filter}, but the predicate is applied to the index of
+(** Same as {!filter}, but the predicate is applied to the index of
the element as first argument (counting from 0), and the element
itself as second argument.
@since 4.11.0
*)
val partition : f:('a -> bool) -> 'a list -> 'a list * 'a list
-(** [partition p l] returns a pair of lists [(l1, l2)], where
+(** [partition ~f l] returns a pair of lists [(l1, l2)], where
[l1] is the list of all the elements of [l] that
- satisfy the predicate [p], and [l2] is the list of all the
- elements of [l] that do not satisfy [p].
+ satisfy the predicate [f], and [l2] is the list of all the
+ elements of [l] that do not satisfy [f].
The order of the elements in the input list is preserved.
*)
+val partition_map : f:('a -> ('b, 'c) Either.t) -> 'a list -> 'b list * 'c list
+(** [partition_map f l] returns a pair of lists [(l1, l2)] such that,
+ for each element [x] of the input list [l]:
+ - if [f x] is [Left y1], then [y1] is in [l1], and
+ - if [f x] is [Right y2], then [y2] is in [l2].
+
+ The output elements are included in [l1] and [l2] in the same
+ relative order as the corresponding input elements in [l].
+
+ In particular, [partition_map (fun x -> if f x then Left x else Right x) l]
+ is equivalent to [partition f l].
+
+ @since 4.12.0
+*)
+
(** {1 Association lists} *)
list [l].
*)
-val assoc_opt: 'a -> ('a * 'b) list -> 'b option
+val assoc_opt : 'a -> ('a * 'b) list -> 'b option
(** [assoc_opt a l] returns the value associated with key [a] in the list of
pairs [l]. That is,
- [assoc a [ ...; (a,b); ...] = b]
+ [assoc_opt a [ ...; (a,b); ...] = Some b]
if [(a,b)] is the leftmost binding of [a] in list [l].
Returns [None] if there is no value associated with [a] in the
list [l].
*)
val assq : 'a -> ('a * 'b) list -> 'b
-(** Same as {!List.assoc}, but uses physical equality instead of
+(** Same as {!assoc}, but uses physical equality instead of
structural equality to compare keys.
*)
-val assq_opt: 'a -> ('a * 'b) list -> 'b option
-(** Same as {!List.assoc_opt}, but uses physical equality instead of
+val assq_opt : 'a -> ('a * 'b) list -> 'b option
+(** Same as {!assoc_opt}, but uses physical equality instead of
structural equality to compare keys.
@since 4.05.0
*)
val mem_assoc : 'a -> map:('a * 'b) list -> bool
-(** Same as {!List.assoc}, but simply return true if a binding exists,
- and false if no bindings exist for the given key.
+(** Same as {!assoc}, but simply return [true] if a binding exists,
+ and [false] if no bindings exist for the given key.
*)
val mem_assq : 'a -> map:('a * 'b) list -> bool
-(** Same as {!List.mem_assoc}, but uses physical equality instead of
+(** Same as {!mem_assoc}, but uses physical equality instead of
structural equality to compare keys.
*)
*)
val remove_assq : 'a -> ('a * 'b) list -> ('a * 'b) list
-(** Same as {!List.remove_assoc}, but uses physical equality instead
+(** Same as {!remove_assoc}, but uses physical equality instead
of structural equality to compare keys. Not tail-recursive.
*)
a complete specification). For example,
{!Stdlib.compare} is a suitable comparison function.
The resulting list is sorted in increasing order.
- [List.sort] is guaranteed to run in constant heap space
+ {!sort} is guaranteed to run in constant heap space
(in addition to the size of the result list) and logarithmic
stack space.
*)
val stable_sort : cmp:('a -> 'a -> int) -> 'a list -> 'a list
-(** Same as {!List.sort}, but the sorting algorithm is guaranteed to
+(** Same as {!sort}, but the sorting algorithm is guaranteed to
be stable (i.e. elements that compare equal are kept in their
- original order) .
+ original order).
The current implementation uses Merge Sort. It runs in constant
heap space and logarithmic stack space.
*)
val fast_sort : cmp:('a -> 'a -> int) -> 'a list -> 'a list
-(** Same as {!List.sort} or {!List.stable_sort}, whichever is
+(** Same as {!sort} or {!stable_sort}, whichever is
faster on typical input.
*)
val sort_uniq : cmp:('a -> 'a -> int) -> 'a list -> 'a list
-(** Same as {!List.sort}, but also remove duplicates.
- @since 4.03.0
+(** Same as {!sort}, but also remove duplicates.
+ @since 4.02.0 (4.03.0 in ListLabels)
*)
val merge : cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
(** Merge two lists:
Assuming that [l1] and [l2] are sorted according to the
- comparison function [cmp], [merge cmp l1 l2] will return a
+ comparison function [cmp], [merge ~cmp l1 l2] will return a
sorted list containing all the elements of [l1] and [l2].
If several elements compare equal, the elements of [l1] will be
before the elements of [l2].
(** {1 Iterators} *)
val to_seq : 'a list -> 'a Seq.t
-(** Iterate on the list
+(** Iterate on the list.
@since 4.07
*)
val of_seq : 'a Seq.t -> 'a list
-(** Create a list from the iterator
+(** Create a list from the iterator.
@since 4.07
*)
module type S =
sig
type key
- type +'a t
+ type !+'a t
val empty: 'a t
val is_empty: 'a t -> bool
val mem: key -> 'a t -> bool
val map: ('a -> 'b) -> 'a t -> 'b t
val mapi: (key -> 'a -> 'b) -> 'a t -> 'b t
val to_seq : 'a t -> (key * 'a) Seq.t
+ val to_rev_seq : 'a t -> (key * 'a) Seq.t
val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
val of_seq : (key * 'a) Seq.t -> 'a t
let to_seq m =
seq_of_enum_ (cons_enum m End)
+ let rec snoc_enum s e =
+ match s with
+ Empty -> e
+ | Node{l; v; d; r} -> snoc_enum r (More(v, d, l, e))
+
+ let rec rev_seq_of_enum_ c () = match c with
+ | End -> Seq.Nil
+ | More (k,v,t,rest) ->
+ Seq.Cons ((k,v), rev_seq_of_enum_ (snoc_enum t rest))
+
+ let to_rev_seq c =
+ rev_seq_of_enum_ (snoc_enum c End)
+
let to_seq_from low m =
let rec aux low m c = match m with
| Empty -> c
(* *)
(**************************************************************************)
+(* NOTE: If this file is map.mli, do not edit it directly! Instead,
+ edit templates/map.template.mli and run tools/sync_stdlib_docs *)
+
(** Association tables over ordered types.
This module implements applicative association tables, also known as
Example: a suitable ordering function is the generic structural
comparison function {!Stdlib.compare}. *)
end
-(** Input signature of the functor {!Map.Make}. *)
+(** Input signature of the functor {!Make}. *)
module type S =
sig
type key
(** The type of the map keys. *)
- type (+'a) t
+ type !+'a t
(** The type of maps from type [key] to type ['a]. *)
val empty: 'a t
and [false] otherwise. *)
val add: key -> 'a -> 'a t -> 'a t
- (** [add x y m] returns a map containing the same bindings as
- [m], plus a binding of [x] to [y]. If [x] was already bound
- in [m] to a value that is physically equal to [y],
+ (** [add key data m] returns a map containing the same bindings as
+ [m], plus a binding of [key] to [data]. If [key] was already bound
+ in [m] to a value that is physically equal to [data],
[m] is returned unchanged (the result of the function is
then physically equal to [m]). Otherwise, the previous binding
- of [x] in [m] disappears.
+ of [key] in [m] disappears.
@before 4.03 Physical equality was not ensured. *)
val update: key -> ('a option -> 'a option) -> 'a t -> 'a t
- (** [update x f m] returns a map containing the same bindings as
- [m], except for the binding of [x]. Depending on the value of
- [y] where [y] is [f (find_opt x m)], the binding of [x] is
+ (** [update key f m] returns a map containing the same bindings as
+ [m], except for the binding of [key]. Depending on the value of
+ [y] where [y] is [f (find_opt key m)], the binding of [key] is
added, removed or updated. If [y] is [None], the binding is
- removed if it exists; otherwise, if [y] is [Some z] then [x]
- is associated to [z] in the resulting map. If [x] was already
+ removed if it exists; otherwise, if [y] is [Some z] then [key]
+ is associated to [z] in the resulting map. If [key] was already
bound in [m] to a value that is physically equal to [z], [m]
is returned unchanged (the result of the function is then
physically equal to [m]).
*)
val singleton: key -> 'a -> 'a t
- (** [singleton x y] returns the one-element map that contains a binding [y]
- for [x].
+ (** [singleton x y] returns the one-element map that contains a binding
+ [y] for [x].
@since 3.12.0
*)
@before 4.03 Physical equality was not ensured. *)
val merge:
- (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
+ (key -> 'a option -> 'b option -> 'c option) ->
+ 'a t -> 'b t -> 'c t
(** [merge f m1 m2] computes a map whose keys are a subset of the keys of
[m1] and of [m2]. The presence of each such binding, and the
corresponding value, is determined with the function [f].
order with respect to the ordering over the type of the keys. *)
val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
- (** [fold f m a] computes [(f kN dN ... (f k1 d1 a)...)],
+ (** [fold f m init] computes [(f kN dN ... (f k1 d1 init)...)],
where [k1 ... kN] are the keys of all bindings in [m]
(in increasing order), and [d1 ... dN] are the associated data. *)
val for_all: (key -> 'a -> bool) -> 'a t -> bool
- (** [for_all p m] checks if all the bindings of the map
- satisfy the predicate [p].
+ (** [for_all f m] checks if all the bindings of the map
+ satisfy the predicate [f].
@since 3.12.0
*)
val exists: (key -> 'a -> bool) -> 'a t -> bool
- (** [exists p m] checks if at least one binding of the map
- satisfies the predicate [p].
+ (** [exists f m] checks if at least one binding of the map
+ satisfies the predicate [f].
@since 3.12.0
*)
val filter: (key -> 'a -> bool) -> 'a t -> 'a t
- (** [filter p m] returns the map with all the bindings in [m]
- that satisfy predicate [p]. If every binding in [m] satisfies [p],
+ (** [filter f m] returns the map with all the bindings in [m]
+ that satisfy predicate [p]. If every binding in [m] satisfies [f],
[m] is returned unchanged (the result of the function is then
physically equal to [m])
@since 3.12.0
*)
val partition: (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
- (** [partition p m] returns a pair of maps [(m1, m2)], where
+ (** [partition f m] returns a pair of maps [(m1, m2)], where
[m1] contains all the bindings of [m] that satisfy the
- predicate [p], and [m2] is the map with all the bindings of
- [m] that do not satisfy [p].
+ predicate [f], and [m2] is the map with all the bindings of
+ [m] that do not satisfy [f].
@since 3.12.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 {!Map.Make}.
+ given to {!Make}.
@since 3.12.0
*)
*)
val max_binding: 'a t -> (key * 'a)
- (** Same as {!Map.S.min_binding}, but returns the binding with
+ (** Same as {!S.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 {!Map.S.min_binding_opt}, but returns the binding with
+ (** Same as {!S.min_binding_opt}, but returns the binding with
the largest key in the given map.
@since 4.05
*)
For example, [find_first (fun k -> Ord.compare k x >= 0) m] will return
the first binding [k, v] of [m] where [Ord.compare k x >= 0]
- (intuitively: [k >= x]), or raise [Not_found] if [x] is greater than any
- element of [m].
+ (intuitively: [k >= x]), or raise [Not_found] if [x] is greater than
+ any element of [m].
@since 4.05
*)
val find_first_opt: (key -> bool) -> 'a t -> (key * 'a) option
- (** [find_first_opt f m], where [f] is a monotonically increasing function,
- returns an option containing the binding of [m] with the lowest key [k]
- such that [f k], or [None] if no such key exists.
+ (** [find_first_opt f m], where [f] is a monotonically increasing
+ function, returns an option containing the binding of [m] with the
+ lowest key [k] such that [f k], or [None] if no such key exists.
@since 4.05
*)
*)
val find_last_opt: (key -> bool) -> 'a t -> (key * 'a) option
- (** [find_last_opt f m], where [f] is a monotonically decreasing function,
- returns an option containing the binding of [m] with the highest key [k]
- such that [f k], or [None] if no such key exists.
+ (** [find_last_opt f m], where [f] is a monotonically decreasing
+ function, returns an option containing the binding of [m] with
+ the highest key [k] such that [f k], or [None] if no such key
+ exists.
@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 {!Map.S.map}, but the function receives as arguments both the
+ (** Same as {!S.map}, but the function receives as arguments both the
key and the associated value for each binding of the map. *)
(** {1 Iterators} *)
(** Iterate on the whole map, in ascending order of keys
@since 4.07 *)
+ val to_rev_seq : 'a t -> (key * 'a) Seq.t
+ (** Iterate on the whole map, in descending order of keys
+ @since 4.12 *)
+
val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
(** [to_seq_from k m] iterates on a subset of the bindings of [m],
in ascending order of keys, from key [k] or above.
(** Build a map from the given bindings
@since 4.07 *)
end
-(** Output signature of the functor {!Map.Make}. *)
+(** Output signature of the functor {!Make}. *)
module Make (Ord : OrderedType) : S with type key = Ord.t
(** Functor building an implementation of the map structure
(* *)
(**************************************************************************)
+(* NOTE: Do not edit this file directly. Edit templates/ and run
+ tools/sync_stdlib_docs *)
+
(** Extra labeled libraries.
- This meta-module provides labelized version of the {!Hashtbl},
- {!Map} and {!Set} modules.
+ This meta-module provides labelized versions of the {!Hashtbl}, {!Map} and
+ {!Set} modules.
+
+ This module is intended to be used through [open MoreLabels] which replaces
+ {!Hashtbl}, {!Map}, and {!Set} with their labeled counterparts.
- They only differ by their labels. They are provided to help
- porting from previous versions of OCaml.
- The contents of this module are subject to change.
+ For example:
+ {[
+ open MoreLabels
+
+ Hashtbl.iter ~f:(fun ~key ~data -> g key data) table
+ ]}
*)
module Hashtbl : sig
- type ('a, 'b) t = ('a, 'b) Hashtbl.t
- val create : ?random:bool -> int -> ('a, 'b) t
+ (** Hash tables and hash functions.
+
+ Hash tables are hashed association tables, with in-place modification.
+ *)
+
+
+ (** {1 Generic interface} *)
+
+
+ type (!'a, !'b) t = ('a, 'b) Hashtbl.t
+ (** The type of hash tables from type ['a] to type ['b]. *)
+
+ val create : ?random: (* thwart tools/sync_stdlib_docs *) bool ->
+ int -> ('a, 'b) t
+ (** [Hashtbl.create n] creates a new, empty hash table, with
+ initial size [n]. For best results, [n] should be on the
+ order of the expected number of elements that will be in
+ the table. The table grows as needed, so [n] is just an
+ initial guess.
+
+ The optional [~][random] parameter (a boolean) controls whether
+ the internal organization of the hash table is randomized at each
+ execution of [Hashtbl.create] or deterministic over all executions.
+
+ A hash table that is created with [~][random] set to [false] uses a
+ fixed hash function ({!hash}) to distribute keys among
+ buckets. As a consequence, collisions between keys happen
+ deterministically. In Web-facing applications or other
+ security-sensitive applications, the deterministic collision
+ patterns can be exploited by a malicious user to create a
+ denial-of-service attack: the attacker sends input crafted to
+ create many collisions in the table, slowing the application down.
+
+ A hash table that is created with [~][random] set to [true] uses the seeded
+ hash function {!seeded_hash} with a seed that is randomly chosen at hash
+ table creation time. In effect, the hash function used is randomly
+ selected among [2^{30}] different hash functions. All these hash
+ functions have different collision patterns, rendering ineffective the
+ denial-of-service attack described above. However, because of
+ randomization, enumerating all elements of the hash table using {!fold}
+ or {!iter} is no longer deterministic: elements are enumerated in
+ different orders at different runs of the program.
+
+ If no [~][random] parameter is given, hash tables are created
+ in non-random mode by default. This default can be changed
+ either programmatically by calling {!randomize} or by
+ setting the [R] flag in the [OCAMLRUNPARAM] environment variable.
+
+ @before 4.00.0 the [~][random] parameter was not present and all
+ hash tables were created in non-randomized mode. *)
+
val clear : ('a, 'b) t -> unit
+ (** Empty a hash table. Use [reset] instead of [clear] to shrink the
+ size of the bucket table to its initial size. *)
+
val reset : ('a, 'b) t -> unit
+ (** Empty a hash table and shrink the size of the bucket table
+ to its initial size.
+ @since 4.00.0 *)
+
val copy : ('a, 'b) t -> ('a, 'b) t
+ (** Return a copy of the given hashtable. *)
+
val add : ('a, 'b) t -> key:'a -> data:'b -> unit
+ (** [Hashtbl.add tbl ~key ~data] adds a binding of [key] to [data]
+ in table [tbl].
+ Previous bindings for [key] are not removed, but simply
+ hidden. That is, after performing {!remove}[ tbl key],
+ the previous binding for [key], if any, is restored.
+ (Same behavior as with association lists.) *)
+
val find : ('a, 'b) t -> 'a -> 'b
+ (** [Hashtbl.find tbl x] returns the current binding of [x] in [tbl],
+ or raises [Not_found] if no such binding exists. *)
+
val find_opt : ('a, 'b) t -> 'a -> 'b option
+ (** [Hashtbl.find_opt tbl x] returns the current binding of [x] in [tbl],
+ or [None] if no such binding exists.
+ @since 4.05 *)
+
val find_all : ('a, 'b) t -> 'a -> 'b list
+ (** [Hashtbl.find_all tbl x] returns the list of all data
+ associated with [x] in [tbl].
+ The current binding is returned first, then the previous
+ bindings, in reverse order of introduction in the table. *)
+
val mem : ('a, 'b) t -> 'a -> bool
+ (** [Hashtbl.mem tbl x] checks if [x] is bound in [tbl]. *)
+
val remove : ('a, 'b) t -> 'a -> unit
+ (** [Hashtbl.remove tbl x] removes the current binding of [x] in [tbl],
+ restoring the previous binding if it exists.
+ It does nothing if [x] is not bound in [tbl]. *)
+
val replace : ('a, 'b) t -> key:'a -> data:'b -> unit
+ (** [Hashtbl.replace tbl ~key ~data] replaces the current binding of [key]
+ in [tbl] by a binding of [key] to [data]. If [key] is unbound in [tbl],
+ a binding of [key] to [data] is added to [tbl].
+ This is functionally equivalent to {!remove}[ tbl key]
+ followed by {!add}[ tbl key data]. *)
+
val iter : f:(key:'a -> data:'b -> unit) -> ('a, 'b) t -> unit
- val filter_map_inplace:
- f:(key:'a -> data:'b -> 'b option) -> ('a, 'b) t -> unit
- val fold :
- f:(key:'a -> data:'b -> 'c -> 'c) ->
- ('a, 'b) t -> init:'c -> 'c
+ (** [Hashtbl.iter ~f tbl] applies [f] to all bindings in table [tbl].
+ [f] receives the key as first argument, and the associated value
+ as second argument. Each binding is presented exactly once to [f].
+
+ The order in which the bindings are passed to [f] is unspecified.
+ However, if the table contains several bindings for the same key,
+ they are passed to [f] in reverse order of introduction, that is,
+ the most recent binding is passed first.
+
+ If the hash table was created in non-randomized mode, the order
+ in which the bindings are enumerated is reproducible between
+ successive runs of the program, and even between minor versions
+ of OCaml. For randomized hash tables, the order of enumeration
+ is entirely random.
+
+ The behavior is not defined if the hash table is modified
+ by [f] during the iteration.
+ *)
+
+ val filter_map_inplace: f:(key:'a -> data:'b -> 'b option) -> ('a, 'b) t ->
+ unit
+ (** [Hashtbl.filter_map_inplace ~f tbl] applies [f] to all bindings in
+ table [tbl] and update each binding depending on the result of
+ [f]. If [f] returns [None], the binding is discarded. If it
+ returns [Some new_val], the binding is update to associate the key
+ to [new_val].
+
+ Other comments for {!iter} apply as well.
+ @since 4.03.0 *)
+
+ val fold : f:(key:'a -> data:'b -> 'c -> 'c) -> ('a, 'b) t -> init:'c -> 'c
+ (** [Hashtbl.fold ~f tbl ~init] computes
+ [(f kN dN ... (f k1 d1 init)...)],
+ where [k1 ... kN] are the keys of all bindings in [tbl],
+ and [d1 ... dN] are the associated values.
+ Each binding is presented exactly once to [f].
+
+ The order in which the bindings are passed to [f] is unspecified.
+ However, if the table contains several bindings for the same key,
+ they are passed to [f] in reverse order of introduction, that is,
+ the most recent binding is passed first.
+
+ If the hash table was created in non-randomized mode, the order
+ in which the bindings are enumerated is reproducible between
+ successive runs of the program, and even between minor versions
+ of OCaml. For randomized hash tables, the order of enumeration
+ is entirely random.
+
+ The behavior is not defined if the hash table is modified
+ by [f] during the iteration.
+ *)
+
val length : ('a, 'b) t -> int
+ (** [Hashtbl.length tbl] returns the number of bindings in [tbl].
+ It takes constant time. Multiple bindings are counted once each, so
+ [Hashtbl.length] gives the number of times [Hashtbl.iter] calls its
+ first argument. *)
+
val randomize : unit -> unit
+ (** After a call to [Hashtbl.randomize()], hash tables are created in
+ randomized mode by default: {!create} returns randomized
+ hash tables, unless the [~random:false] optional parameter is given.
+ The same effect can be achieved by setting the [R] parameter in
+ the [OCAMLRUNPARAM] environment variable.
+
+ It is recommended that applications or Web frameworks that need to
+ protect themselves against the denial-of-service attack described
+ in {!create} call [Hashtbl.randomize()] at initialization
+ time.
+
+ Note that once [Hashtbl.randomize()] was called, there is no way
+ to revert to the non-randomized default behavior of {!create}.
+ This is intentional. Non-randomized hash tables can still be
+ created using [Hashtbl.create ~random:false].
+
+ @since 4.00.0 *)
+
val is_randomized : unit -> bool
- type statistics = Hashtbl.statistics
+ (** Return [true] if the tables are currently created in randomized mode
+ by default, [false] otherwise.
+ @since 4.03.0 *)
+
+ val rebuild : ?random (* thwart tools/sync_stdlib_docs *) :bool ->
+ ('a, 'b) t -> ('a, 'b) t
+ (** Return a copy of the given hashtable. Unlike {!copy},
+ {!rebuild}[ h] re-hashes all the (key, value) entries of
+ the original table [h]. The returned hash table is randomized if
+ [h] was randomized, or the optional [random] parameter is true, or
+ if the default is to create randomized hash tables; see
+ {!create} for more information.
+
+ {!rebuild} can safely be used to import a hash table built
+ by an old version of the {!Hashtbl} module, then marshaled to
+ persistent storage. After unmarshaling, apply {!rebuild}
+ to produce a hash table for the current version of the {!Hashtbl}
+ module.
+
+ @since 4.12.0 *)
+
+ (** @since 4.00.0 *)
+ type statistics = Hashtbl.statistics = {
+ num_bindings: int;
+ (** Number of bindings present in the table.
+ Same value as returned by {!length}. *)
+ num_buckets: int;
+ (** Number of buckets in the table. *)
+ max_bucket_length: int;
+ (** Maximal number of bindings per bucket. *)
+ bucket_histogram: int array
+ (** Histogram of bucket sizes. This array [histo] has
+ length [max_bucket_length + 1]. The value of
+ [histo.(i)] is the number of buckets whose size is [i]. *)
+ }
+
val stats : ('a, 'b) t -> statistics
+ (** [Hashtbl.stats tbl] returns statistics about the table [tbl]:
+ number of buckets, size of the biggest bucket, distribution of
+ buckets by size.
+ @since 4.00.0 *)
+
+ (** {1 Iterators} *)
+
val to_seq : ('a,'b) t -> ('a * 'b) Seq.t
+ (** Iterate on the whole table. The order in which the bindings
+ appear in the sequence is unspecified. However, if the table contains
+ 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
+ during the iteration.
+
+ @since 4.07 *)
+
val to_seq_keys : ('a,_) t -> 'a Seq.t
+ (** Same as [Seq.map fst (to_seq m)]
+ @since 4.07 *)
+
val to_seq_values : (_,'b) t -> 'b Seq.t
+ (** Same as [Seq.map snd (to_seq m)]
+ @since 4.07 *)
+
val add_seq : ('a,'b) t -> ('a * 'b) Seq.t -> unit
+ (** Add the given bindings to the table, using {!add}
+ @since 4.07 *)
+
val replace_seq : ('a,'b) t -> ('a * 'b) Seq.t -> unit
+ (** Add the given bindings to the table, using {!replace}
+ @since 4.07 *)
+
val of_seq : ('a * 'b) Seq.t -> ('a, 'b) t
- module type HashedType = Hashtbl.HashedType
- module type SeededHashedType = Hashtbl.SeededHashedType
+ (** Build a table from the given bindings. The bindings are added
+ in the same order they appear in the sequence, using {!replace_seq},
+ which means that if two pairs have the same key, only the latest one
+ will appear in the table.
+ @since 4.07 *)
+
+ (** {1 Functorial interface} *)
+
+ (** The functorial interface allows the use of specific comparison
+ and hash functions, either for performance/security concerns,
+ or because keys are not hashable/comparable with the polymorphic builtins.
+
+ For instance, one might want to specialize a table for integer keys:
+ {[
+ module IntHash =
+ struct
+ type t = int
+ let equal i j = i=j
+ let hash i = i land max_int
+ end
+
+ module IntHashtbl = Hashtbl.Make(IntHash)
+
+ let h = IntHashtbl.create 17 in
+ IntHashtbl.add h 12 "hello"
+ ]}
+
+ This creates a new module [IntHashtbl], with a new type ['a
+ IntHashtbl.t] of tables from [int] to ['a]. In this example, [h]
+ contains [string] values so its type is [string IntHashtbl.t].
+
+ Note that the new type ['a IntHashtbl.t] is not compatible with
+ the type [('a,'b) Hashtbl.t] of the generic interface. For
+ example, [Hashtbl.length h] would not type-check, you must use
+ [IntHashtbl.length].
+ *)
+
+ module type HashedType =
+ sig
+ type t
+ (** The type of the hashtable keys. *)
+
+ val equal : t -> t -> bool
+ (** The equality predicate used to compare keys. *)
+
+ val hash : t -> int
+ (** A hashing function on keys. It must be such that if two keys are
+ equal according to [equal], then they have identical hash values
+ as computed by [hash].
+ Examples: suitable ([equal], [hash]) pairs for arbitrary key
+ types include
+ - ([(=)], {!hash}) for comparing objects by structure
+ (provided objects do not contain floats)
+ - ([(fun x y -> compare x y = 0)], {!hash})
+ for comparing objects by structure
+ and handling {!Stdlib.nan} correctly
+ - ([(==)], {!hash}) for comparing objects by physical
+ equality (e.g. for mutable or cyclic objects). *)
+ end
+ (** The input signature of the functor {!Make}. *)
+
module type S =
sig
type key
- and 'a t
+ type !'a t
val create : int -> 'a t
val clear : 'a t -> unit
- val reset : 'a t -> unit
+ val reset : 'a t -> unit (** @since 4.00.0 *)
+
val copy : 'a t -> 'a t
val add : 'a t -> key:key -> data:'a -> unit
val remove : 'a t -> key -> unit
val find : 'a t -> key -> 'a
- val find_opt: 'a t -> key -> 'a option
+ val find_opt : 'a t -> key -> 'a option
+ (** @since 4.05.0 *)
+
val find_all : 'a t -> key -> 'a list
val replace : 'a t -> key:key -> data:'a -> unit
val mem : 'a t -> key -> bool
val iter : f:(key:key -> data:'a -> unit) -> 'a t -> unit
- val filter_map_inplace:
- f:(key:key -> data:'a -> 'a option) -> 'a t -> unit
- val fold :
- f:(key:key -> data:'a -> 'b -> 'b) ->
- 'a t -> init:'b -> 'b
+ val filter_map_inplace: f:(key:key -> data:'a -> 'a option) -> 'a t ->
+ unit
+ (** @since 4.03.0 *)
+
+ val fold : f:(key:key -> data:'a -> 'b -> 'b) -> 'a t -> init:'b -> 'b
val length : 'a t -> int
- val stats: 'a t -> statistics
+ val stats: 'a t -> statistics (** @since 4.00.0 *)
+
val to_seq : 'a t -> (key * 'a) Seq.t
+ (** @since 4.07 *)
+
val to_seq_keys : _ t -> key Seq.t
+ (** @since 4.07 *)
+
val to_seq_values : 'a t -> 'a Seq.t
+ (** @since 4.07 *)
+
val add_seq : 'a t -> (key * 'a) Seq.t -> unit
+ (** @since 4.07 *)
+
val replace_seq : 'a t -> (key * 'a) Seq.t -> unit
+ (** @since 4.07 *)
+
val of_seq : (key * 'a) Seq.t -> 'a t
+ (** @since 4.07 *)
end
+ (** The output signature of the functor {!Make}. *)
+
+ module Make : functor (H : HashedType) -> S
+ with type key = H.t
+ and type 'a t = 'a Hashtbl.Make(H).t
+ (** Functor building an implementation of the hashtable structure.
+ The functor [Hashtbl.Make] returns a structure containing
+ a type [key] of keys and a type ['a t] of hash tables
+ associating data of type ['a] to keys of type [key].
+ The operations perform similarly to those of the generic
+ interface, but use the hashing and equality functions
+ specified in the functor argument [H] instead of generic
+ equality and hashing. Since the hash function is not seeded,
+ the [create] operation of the result structure always returns
+ non-randomized hash tables. *)
+
+ module type SeededHashedType =
+ sig
+ type t
+ (** The type of the hashtable keys. *)
+
+ val equal: t -> t -> bool
+ (** The equality predicate used to compare keys. *)
+
+ val hash: int -> t -> int
+ (** 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. *)
+ end
+ (** The input signature of the functor {!MakeSeeded}.
+ @since 4.00.0 *)
+
module type SeededS =
sig
type key
- and 'a t
- val create : ?random:bool -> int -> 'a t
+ 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:key -> data:'a -> unit
val remove : 'a t -> key -> unit
val find : 'a t -> key -> 'a
- val find_opt : 'a t -> key -> 'a option
+ val find_opt : 'a t -> key -> 'a option (** @since 4.05.0 *)
+
val find_all : 'a t -> key -> 'a list
val replace : 'a t -> key:key -> data:'a -> unit
val mem : 'a t -> key -> bool
val iter : f:(key:key -> data:'a -> unit) -> 'a t -> unit
- val filter_map_inplace:
- f:(key:key -> data:'a -> 'a option) -> 'a t -> unit
- val fold :
- f:(key:key -> data:'a -> 'b -> 'b) ->
- 'a t -> init:'b -> 'b
+ val filter_map_inplace: f:(key:key -> data:'a -> 'a option) -> 'a t ->
+ unit
+ (** @since 4.03.0 *)
+
+ val fold : f:(key:key -> data:'a -> 'b -> 'b) -> 'a t -> init:'b -> 'b
val length : 'a t -> int
val stats: 'a t -> statistics
+
val to_seq : 'a t -> (key * 'a) Seq.t
+ (** @since 4.07 *)
+
val to_seq_keys : _ t -> key Seq.t
+ (** @since 4.07 *)
+
val to_seq_values : 'a t -> 'a Seq.t
+ (** @since 4.07 *)
+
val add_seq : 'a t -> (key * 'a) Seq.t -> unit
+ (** @since 4.07 *)
+
val replace_seq : 'a t -> (key * 'a) Seq.t -> unit
+ (** @since 4.07 *)
+
val of_seq : (key * 'a) Seq.t -> 'a t
+ (** @since 4.07 *)
end
- module Make : functor (H : HashedType) -> S
- with type key = H.t
- and type 'a t = 'a Hashtbl.Make(H).t
- module MakeSeeded (H : SeededHashedType) : SeededS
+ (** The output signature of the functor {!MakeSeeded}.
+ @since 4.00.0 *)
+
+ module MakeSeeded (H : SeededHashedType) : SeededS
with type key = H.t
and type 'a t = 'a Hashtbl.MakeSeeded(H).t
+ (** Functor building an implementation of the hashtable structure.
+ The functor [Hashtbl.MakeSeeded] returns a structure containing
+ a type [key] of keys and a type ['a t] of hash tables
+ associating data of type ['a] to keys of type [key].
+ The operations perform similarly to those of the generic
+ interface, but use the seeded hashing and equality functions
+ specified in the functor argument [H] instead of generic
+ equality and hashing. The [create] operation of the
+ result structure supports the [~][random] optional parameter
+ and returns randomized hash tables if [~random:true] is passed
+ or if randomization is globally on (see {!Hashtbl.randomize}).
+ @since 4.00.0 *)
+
+
+ (** {1 The polymorphic hash functions} *)
+
+
val hash : 'a -> int
+ (** [Hashtbl.hash x] associates a nonnegative integer to any value of
+ any type. It is guaranteed that
+ if [x = y] or [Stdlib.compare x y = 0], then [hash x = hash y].
+ Moreover, [hash] always terminates, even on cyclic structures. *)
+
val seeded_hash : int -> 'a -> int
+ (** A variant of {!hash} that is further parameterized by
+ an integer seed.
+ @since 4.00.0 *)
+
val hash_param : int -> int -> 'a -> int
+ (** [Hashtbl.hash_param meaningful total x] computes a hash value for [x],
+ with the same properties as for [hash]. The two extra integer
+ parameters [meaningful] and [total] give more precise control over
+ hashing. Hashing performs a breadth-first, left-to-right traversal
+ of the structure [x], stopping after [meaningful] meaningful nodes
+ were encountered, or [total] nodes (meaningful or not) were
+ encountered. If [total] as specified by the user exceeds a certain
+ value, currently 256, then it is capped to that value.
+ Meaningful nodes are: integers; floating-point
+ numbers; strings; characters; booleans; and constant
+ constructors. Larger values of [meaningful] and [total] means that
+ more nodes are taken into account to compute the final hash value,
+ and therefore collisions are less likely to happen. However,
+ hashing takes longer. The parameters [meaningful] and [total]
+ govern the tradeoff between accuracy and speed. As default
+ choices, {!hash} and {!seeded_hash} take
+ [meaningful = 10] and [total = 100]. *)
+
val seeded_hash_param : int -> int -> int -> 'a -> int
+ (** A variant of {!hash_param} that is further parameterized by
+ an integer seed. Usage:
+ [Hashtbl.seeded_hash_param meaningful total seed x].
+ @since 4.00.0 *)
+
end
module Map : sig
- module type OrderedType = Map.OrderedType
+ (** Association tables over ordered types.
+
+ This module implements applicative association tables, also known as
+ finite maps or dictionaries, given a total ordering function
+ over the keys.
+ All operations over maps are purely applicative (no side-effects).
+ The implementation uses balanced binary trees, and therefore searching
+ and insertion take time logarithmic in the size of the map.
+
+ For instance:
+ {[
+ module IntPairs =
+ struct
+ type t = int * int
+ let compare (x0,y0) (x1,y1) =
+ match Stdlib.compare x0 x1 with
+ 0 -> Stdlib.compare y0 y1
+ | c -> c
+ end
+
+ module PairsMap = Map.Make(IntPairs)
+
+ let m = PairsMap.(empty |> add (0,1) "hello" |> add (1,0) "world")
+ ]}
+
+ This creates a new module [PairsMap], with a new type ['a PairsMap.t]
+ of maps from [int * int] to ['a]. In this example, [m] contains [string]
+ values so its type is [string PairsMap.t].
+ *)
+
+ module type OrderedType =
+ sig
+ type t
+ (** The type of the map keys. *)
+
+ val compare : t -> t -> int
+ (** A total ordering function over the keys.
+ This is a two-argument function [f] such that
+ [f e1 e2] is zero if the keys [e1] and [e2] are equal,
+ [f e1 e2] is strictly negative if [e1] is smaller than [e2],
+ and [f e1 e2] is strictly positive if [e1] is greater than [e2].
+ Example: a suitable ordering function is the generic structural
+ comparison function {!Stdlib.compare}. *)
+ end
+ (** Input signature of the functor {!Make}. *)
+
module type S =
sig
type key
- and (+'a) t
- val empty : 'a t
+ (** The type of the map keys. *)
+
+ type !+'a t
+ (** The type of maps from type [key] to type ['a]. *)
+
+ val empty: 'a t
+ (** The empty map. *)
+
val is_empty: 'a t -> bool
- val mem : key -> 'a t -> bool
- val add : key:key -> data:'a -> 'a t -> 'a t
+ (** Test whether a map is empty or not. *)
+
+ val mem: key -> 'a t -> bool
+ (** [mem x m] returns [true] if [m] contains a binding for [x],
+ and [false] otherwise. *)
+
+ val add: key:key -> data:'a -> 'a t -> 'a t
+ (** [add ~key ~data m] returns a map containing the same bindings as
+ [m], plus a binding of [key] to [data]. If [key] was already bound
+ in [m] to a value that is physically equal to [data],
+ [m] is returned unchanged (the result of the function is
+ then physically equal to [m]). Otherwise, the previous binding
+ of [key] in [m] disappears.
+ @before 4.03 Physical equality was not ensured. *)
+
val update: key:key -> f:('a option -> 'a option) -> 'a t -> 'a t
+ (** [update ~key ~f m] returns a map containing the same bindings as
+ [m], except for the binding of [key]. Depending on the value of
+ [y] where [y] is [f (find_opt key m)], the binding of [key] is
+ added, removed or updated. If [y] is [None], the binding is
+ removed if it exists; otherwise, if [y] is [Some z] then [key]
+ is associated to [z] in the resulting map. If [key] was already
+ bound in [m] to a value that is physically equal to [z], [m]
+ is returned unchanged (the result of the function is then
+ physically equal to [m]).
+ @since 4.06.0
+ *)
+
val singleton: key -> 'a -> 'a t
- val remove : key -> 'a t -> 'a t
+ (** [singleton x y] returns the one-element map that contains a binding
+ [y] for [x].
+ @since 3.12.0
+ *)
+
+ val remove: key -> 'a t -> 'a t
+ (** [remove x m] returns a map containing the same bindings as
+ [m], except for [x] which is unbound in the returned map.
+ If [x] was not in [m], [m] is returned unchanged
+ (the result of the function is then physically equal to [m]).
+ @before 4.03 Physical equality was not ensured. *)
+
val merge:
- f:(key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
+ f:(key -> 'a option -> 'b option -> 'c option) ->
+ 'a t -> 'b t -> 'c t
+ (** [merge ~f m1 m2] computes a map whose keys are a subset of the keys of
+ [m1] and of [m2]. The presence of each such binding, and the
+ corresponding value, is determined with the function [f].
+ In terms of the [find_opt] operation, we have
+ [find_opt x (merge f m1 m2) = f x (find_opt x m1) (find_opt x m2)]
+ for any key [x], provided that [f x None None = None].
+ @since 3.12.0
+ *)
+
val union: f:(key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
+ (** [union ~f m1 m2] computes a map whose keys are a subset of the keys
+ of [m1] and of [m2]. When the same binding is defined in both
+ arguments, the function [f] is used to combine them.
+ This is a special case of [merge]: [union f m1 m2] is equivalent
+ to [merge f' m1 m2], where
+ - [f' _key None None = None]
+ - [f' _key (Some v) None = Some v]
+ - [f' _key None (Some v) = Some v]
+ - [f' key (Some v1) (Some v2) = f key v1 v2]
+
+ @since 4.03.0
+ *)
+
val compare: cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int
+ (** Total ordering between maps. The first argument is a total ordering
+ used to compare data associated with equal keys in the two maps. *)
+
val equal: cmp:('a -> 'a -> bool) -> 'a t -> 'a t -> bool
- val iter : f:(key:key -> data:'a -> unit) -> 'a t -> unit
- val fold :
- f:(key:key -> data:'a -> 'b -> 'b) ->
- 'a t -> init:'b -> 'b
+ (** [equal ~cmp m1 m2] tests whether the maps [m1] and [m2] are
+ equal, that is, contain equal keys and associate them with
+ equal data. [cmp] is the equality predicate used to compare
+ the data associated with the keys. *)
+
+ val iter: f:(key:key -> data:'a -> unit) -> 'a t -> unit
+ (** [iter ~f m] applies [f] to all bindings in map [m].
+ [f] receives the key as first argument, and the associated value
+ as second argument. The bindings are passed to [f] in increasing
+ order with respect to the ordering over the type of the keys. *)
+
+ val fold: f:(key:key -> data:'a -> 'b -> 'b) -> 'a t -> init:'b -> 'b
+ (** [fold ~f m ~init] computes [(f kN dN ... (f k1 d1 init)...)],
+ where [k1 ... kN] are the keys of all bindings in [m]
+ (in increasing order), and [d1 ... dN] are the associated data. *)
+
val for_all: f:(key -> 'a -> bool) -> 'a t -> bool
+ (** [for_all ~f m] checks if all the bindings of the map
+ satisfy the predicate [f].
+ @since 3.12.0
+ *)
+
val exists: f:(key -> 'a -> bool) -> 'a t -> bool
+ (** [exists ~f m] checks if at least one binding of the map
+ satisfies the predicate [f].
+ @since 3.12.0
+ *)
+
val filter: f:(key -> 'a -> bool) -> 'a t -> 'a t
+ (** [filter ~f m] returns the map with all the bindings in [m]
+ that satisfy predicate [p]. If every binding in [m] satisfies [f],
+ [m] is returned unchanged (the result of the function is then
+ physically equal to [m])
+ @since 3.12.0
+ @before 4.03 Physical equality was not ensured.
+ *)
+
val filter_map: f:(key -> 'a -> 'b option) -> 'a t -> 'b t
+ (** [filter_map ~f m] applies the function [f] to every binding of
+ [m], and builds a map from the results. For each binding
+ [(k, v)] in the input map:
+ - if [f k v] is [None] then [k] is not in the result,
+ - if [f k v] is [Some v'] then the binding [(k, v')]
+ is in the output map.
+
+ For example, the following function on maps whose values are lists
+ {[
+ filter_map
+ (fun _k li -> match li with [] -> None | _::tl -> Some tl)
+ m
+ ]}
+ drops all bindings of [m] whose value is an empty list, and pops
+ the first element of each value that is non-empty.
+
+ @since 4.11.0
+ *)
+
val partition: f:(key -> 'a -> bool) -> 'a t -> 'a t * 'a t
+ (** [partition ~f m] returns a pair of maps [(m1, m2)], where
+ [m1] contains all the bindings of [m] that satisfy the
+ predicate [f], and [m2] is the map with all the bindings of
+ [m] that do not satisfy [f].
+ @since 3.12.0
+ *)
+
val cardinal: 'a t -> int
+ (** Return the number of bindings of a map.
+ @since 3.12.0
+ *)
+
val bindings: 'a t -> (key * 'a) list
+ (** 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}.
+ @since 3.12.0
+ *)
+
val min_binding: 'a t -> (key * 'a)
+ (** Return the binding with the smallest key in a given map
+ (with respect to the [Ord.compare] ordering), or raise
+ [Not_found] if the map is empty.
+ @since 3.12.0
+ *)
+
val min_binding_opt: 'a t -> (key * 'a) option
+ (** Return the binding with the smallest key in the given map
+ (with respect to the [Ord.compare] ordering), or [None]
+ if the map is empty.
+ @since 4.05
+ *)
+
val max_binding: 'a t -> (key * 'a)
+ (** Same as {!S.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
+ the largest key in the given map.
+ @since 4.05
+ *)
+
val choose: 'a t -> (key * 'a)
+ (** Return one binding of the given map, or raise [Not_found] if
+ the map is empty. Which binding is chosen is unspecified,
+ but equal bindings will be chosen for equal maps.
+ @since 3.12.0
+ *)
+
val choose_opt: 'a t -> (key * 'a) option
+ (** Return one binding of the given map, or [None] if
+ the map is empty. Which binding is chosen is unspecified,
+ but equal bindings will be chosen for equal maps.
+ @since 4.05
+ *)
+
val split: key -> 'a t -> 'a t * 'a option * 'a t
- val find : key -> 'a t -> 'a
+ (** [split x m] returns a triple [(l, data, r)], where
+ [l] is the map with all the bindings of [m] whose key
+ is strictly less than [x];
+ [r] is the map with all the bindings of [m] whose key
+ is strictly greater than [x];
+ [data] is [None] if [m] contains no binding for [x],
+ or [Some v] if [m] binds [v] to [x].
+ @since 3.12.0
+ *)
+
+ val find: key -> 'a t -> 'a
+ (** [find x m] returns the current value of [x] in [m],
+ or raises [Not_found] if no binding for [x] exists. *)
+
val find_opt: key -> 'a t -> 'a option
- val find_first : f:(key -> bool) -> 'a t -> key * 'a
- val find_first_opt : f:(key -> bool) -> 'a t -> (key * 'a) option
- val find_last : f:(key -> bool) -> 'a t -> key * 'a
- val find_last_opt : f:(key -> bool) -> 'a t -> (key * 'a) option
- val map : f:('a -> 'b) -> 'a t -> 'b t
- val mapi : f:(key -> 'a -> 'b) -> 'a t -> 'b t
+ (** [find_opt x m] returns [Some v] if the current value of [x]
+ in [m] is [v], or [None] if no binding for [x] exists.
+ @since 4.05
+ *)
+
+ val find_first: f:(key -> bool) -> 'a t -> key * 'a
+ (** [find_first ~f m], where [f] is a monotonically increasing function,
+ returns the binding of [m] with the lowest key [k] such that [f k],
+ or raises [Not_found] if no such key exists.
+
+ For example, [find_first (fun k -> Ord.compare k x >= 0) m] will return
+ the first binding [k, v] of [m] where [Ord.compare k x >= 0]
+ (intuitively: [k >= x]), or raise [Not_found] if [x] is greater than
+ any element of [m].
+
+ @since 4.05
+ *)
+
+ val find_first_opt: f:(key -> bool) -> 'a t -> (key * 'a) option
+ (** [find_first_opt ~f m], where [f] is a monotonically increasing
+ function, returns an option containing the binding of [m] with the
+ lowest key [k] such that [f k], or [None] if no such key exists.
+ @since 4.05
+ *)
+
+ val find_last: f:(key -> bool) -> 'a t -> key * 'a
+ (** [find_last ~f m], where [f] is a monotonically decreasing function,
+ returns the binding of [m] with the highest key [k] such that [f k],
+ or raises [Not_found] if no such key exists.
+ @since 4.05
+ *)
+
+ val find_last_opt: f:(key -> bool) -> 'a t -> (key * 'a) option
+ (** [find_last_opt ~f m], where [f] is a monotonically decreasing
+ function, returns an option containing the binding of [m] with
+ the highest key [k] such that [f k], or [None] if no such key
+ exists.
+ @since 4.05
+ *)
+
+ val map: f:('a -> 'b) -> 'a t -> 'b t
+ (** [map ~f m] returns a map with same domain as [m], where the
+ associated value [a] of all bindings of [m] has been
+ replaced by the result of the application of [f] to [a].
+ The bindings are passed to [f] in increasing order
+ 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
+ key and the associated value for each binding of the map. *)
+
+ (** {1 Iterators} *)
+
val to_seq : 'a t -> (key * 'a) Seq.t
+ (** Iterate on the whole map, in ascending order of keys
+ @since 4.07 *)
+
+ val to_rev_seq : 'a t -> (key * 'a) Seq.t
+ (** Iterate on the whole map, in descending order of keys
+ @since 4.12 *)
+
val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
+ (** [to_seq_from k m] iterates on a subset of the bindings of [m],
+ in ascending order of keys, from key [k] or above.
+ @since 4.07 *)
+
val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
+ (** Add the given bindings to the map, in order.
+ @since 4.07 *)
+
val of_seq : (key * 'a) Seq.t -> 'a t
- end
- module Make : functor (Ord : OrderedType) -> S
+ (** Build a map from the given bindings
+ @since 4.07 *)
+ end
+ (** Output signature of the functor {!Make}. *)
+
+ module Make : functor (Ord : OrderedType) -> S
with type key = Ord.t
and type 'a t = 'a Map.Make(Ord).t
+ (** Functor building an implementation of the map structure
+ given a totally ordered type. *)
+
end
module Set : sig
- module type OrderedType = Set.OrderedType
+ (** Sets over ordered types.
+
+ This module implements the set data structure, given a total ordering
+ function over the set elements. All operations over sets
+ are purely applicative (no side-effects).
+ The implementation uses balanced binary trees, and is therefore
+ reasonably efficient: insertion and membership take time
+ logarithmic in the size of the set, for instance.
+
+ The {!Make} functor constructs implementations for any type, given a
+ [compare] function.
+ For instance:
+ {[
+ module IntPairs =
+ struct
+ type t = int * int
+ let compare (x0,y0) (x1,y1) =
+ match Stdlib.compare x0 x1 with
+ 0 -> Stdlib.compare y0 y1
+ | c -> c
+ end
+
+ module PairsSet = Set.Make(IntPairs)
+
+ let m = PairsSet.(empty |> add (2,3) |> add (5,7) |> add (11,13))
+ ]}
+
+ This creates a new module [PairsSet], with a new type [PairsSet.t]
+ of sets of [int * int].
+ *)
+
+ module type OrderedType =
+ sig
+ type t
+ (** The type of the set elements. *)
+
+ val compare : t -> t -> int
+ (** A total ordering function over the set elements.
+ This is a two-argument function [f] such that
+ [f e1 e2] is zero if the elements [e1] and [e2] are equal,
+ [f e1 e2] is strictly negative if [e1] is smaller than [e2],
+ and [f e1 e2] is strictly positive if [e1] is greater than [e2].
+ Example: a suitable ordering function is the generic structural
+ comparison function {!Stdlib.compare}. *)
+ end
+ (** Input signature of the functor {!Make}. *)
+
module type S =
sig
type elt
- and 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 : f:(elt -> unit) -> t -> unit
- val map : f:(elt -> elt) -> t -> t
- val fold : f:(elt -> 'a -> 'a) -> t -> init:'a -> 'a
- val for_all : f:(elt -> bool) -> t -> bool
- val exists : f:(elt -> bool) -> t -> bool
- val filter : f:(elt -> bool) -> t -> t
- val filter_map : f:(elt -> elt option) -> t -> t
- val partition : f:(elt -> bool) -> t -> t * t
- val cardinal : t -> int
- val elements : t -> elt list
- val min_elt : t -> elt
+ (** The type of the set elements. *)
+
+ type t
+ (** The type of sets. *)
+
+ val empty: t
+ (** The empty set. *)
+
+ val is_empty: t -> bool
+ (** Test whether a set is empty or not. *)
+
+ val mem: elt -> t -> bool
+ (** [mem x s] tests whether [x] belongs to the set [s]. *)
+
+ val add: elt -> t -> t
+ (** [add x s] returns a set containing all elements of [s],
+ plus [x]. If [x] was already in [s], [s] is returned unchanged
+ (the result of the function is then physically equal to [s]).
+ @before 4.03 Physical equality was not ensured. *)
+
+ val singleton: elt -> t
+ (** [singleton x] returns the one-element set containing only [x]. *)
+
+ val remove: elt -> t -> t
+ (** [remove x s] returns a set containing all elements of [s],
+ except [x]. If [x] was not in [s], [s] is returned unchanged
+ (the result of the function is then physically equal to [s]).
+ @before 4.03 Physical equality was not ensured. *)
+
+ val union: t -> t -> t
+ (** Set union. *)
+
+ val inter: t -> t -> t
+ (** Set intersection. *)
+
+ val disjoint: t -> t -> bool
+ (** Test if two sets are disjoint.
+ @since 4.08.0 *)
+
+ val diff: t -> t -> t
+ (** Set difference: [diff s1 s2] contains the elements of [s1]
+ that are not in [s2]. *)
+
+ val compare: t -> t -> int
+ (** Total ordering between sets. Can be used as the ordering function
+ for doing sets of sets. *)
+
+ val equal: t -> t -> bool
+ (** [equal s1 s2] tests whether the sets [s1] and [s2] are
+ equal, that is, contain equal elements. *)
+
+ val subset: t -> t -> bool
+ (** [subset s1 s2] tests whether the set [s1] is a subset of
+ the set [s2]. *)
+
+ val iter: f:(elt -> unit) -> t -> unit
+ (** [iter ~f s] applies [f] in turn to all elements of [s].
+ The elements of [s] are presented to [f] in increasing order
+ with respect to the ordering over the type of the elements. *)
+
+ val map: f:(elt -> elt) -> t -> t
+ (** [map ~f s] is the set whose elements are [f a0],[f a1]... [f
+ aN], where [a0],[a1]...[aN] are the elements of [s].
+
+ The elements are passed to [f] in increasing order
+ with respect to the ordering over the type of the elements.
+
+ If no element of [s] is changed by [f], [s] is returned
+ unchanged. (If each output of [f] is physically equal to its
+ input, the returned set is physically equal to [s].)
+ @since 4.04.0 *)
+
+ val fold: f:(elt -> 'a -> 'a) -> t -> init:'a -> 'a
+ (** [fold ~f s init] computes [(f xN ... (f x2 (f x1 init))...)],
+ where [x1 ... xN] are the elements of [s], in increasing order. *)
+
+ val for_all: f:(elt -> bool) -> t -> bool
+ (** [for_all ~f s] checks if all elements of the set
+ satisfy the predicate [f]. *)
+
+ val exists: f:(elt -> bool) -> t -> bool
+ (** [exists ~f s] checks if at least one element of
+ the set satisfies the predicate [f]. *)
+
+ val filter: f:(elt -> bool) -> t -> t
+ (** [filter ~f s] returns the set of all elements in [s]
+ that satisfy predicate [f]. If [f] satisfies every element in [s],
+ [s] is returned unchanged (the result of the function is then
+ physically equal to [s]).
+ @before 4.03 Physical equality was not ensured.*)
+
+ val filter_map: f:(elt -> elt option) -> t -> t
+ (** [filter_map ~f s] returns the set of all [v] such that
+ [f x = Some v] for some element [x] of [s].
+
+ For example,
+ {[filter_map (fun n -> if n mod 2 = 0 then Some (n / 2) else None) s]}
+ is the set of halves of the even elements of [s].
+
+ If no element of [s] is changed or dropped by [f] (if
+ [f x = Some x] for each element [x]), then
+ [s] is returned unchanged: the result of the function
+ is then physically equal to [s].
+
+ @since 4.11.0
+ *)
+
+ val partition: f:(elt -> bool) -> t -> t * t
+ (** [partition ~f s] returns a pair of sets [(s1, s2)], where
+ [s1] is the set of all the elements of [s] that satisfy the
+ predicate [f], and [s2] is the set of all the elements of
+ [s] that do not satisfy [f]. *)
+
+ val cardinal: t -> int
+ (** Return the number of elements of a set. *)
+
+ val elements: t -> elt list
+ (** 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}. *)
+
+ val min_elt: t -> elt
+ (** Return the smallest element of the given set
+ (with respect to the [Ord.compare] ordering), or raise
+ [Not_found] if the set is empty. *)
+
val min_elt_opt: t -> elt option
- val max_elt : t -> elt
+ (** Return the smallest element of the given set
+ (with respect to the [Ord.compare] ordering), or [None]
+ if the set is empty.
+ @since 4.05
+ *)
+
+ val max_elt: t -> elt
+ (** Same as {!S.min_elt}, but returns the largest element of the
+ given set. *)
+
val max_elt_opt: t -> elt option
- val choose : t -> elt
+ (** Same as {!S.min_elt_opt}, but returns the largest element of the
+ given set.
+ @since 4.05
+ *)
+
+ val choose: t -> elt
+ (** Return one element of the given set, or raise [Not_found] if
+ the set is empty. Which element is chosen is unspecified,
+ but equal elements will be chosen for equal sets. *)
+
val choose_opt: t -> elt option
+ (** Return one element of the given set, or [None] if
+ the set is empty. Which element is chosen is unspecified,
+ but equal elements will be chosen for equal sets.
+ @since 4.05
+ *)
+
val split: elt -> t -> t * bool * t
+ (** [split x s] returns a triple [(l, present, r)], where
+ [l] is the set of elements of [s] that are
+ strictly less than [x];
+ [r] is the set of elements of [s] that are
+ strictly greater than [x];
+ [present] is [false] if [s] contains no element equal to [x],
+ or [true] if [s] contains an element equal to [x]. *)
+
val find: elt -> t -> elt
+ (** [find x s] returns the element of [s] equal to [x] (according
+ to [Ord.compare]), or raise [Not_found] if no such element
+ exists.
+ @since 4.01.0 *)
+
val find_opt: elt -> t -> elt option
+ (** [find_opt x s] returns the element of [s] equal to [x] (according
+ to [Ord.compare]), or [None] if no such element
+ exists.
+ @since 4.05 *)
+
val find_first: f:(elt -> bool) -> t -> elt
+ (** [find_first ~f s], where [f] is a monotonically increasing function,
+ returns the lowest element [e] of [s] such that [f e],
+ or raises [Not_found] if no such element exists.
+
+ For example, [find_first (fun e -> Ord.compare e x >= 0) s] will return
+ the first element [e] of [s] where [Ord.compare e x >= 0] (intuitively:
+ [e >= x]), or raise [Not_found] if [x] is greater than any element of
+ [s].
+
+ @since 4.05
+ *)
+
val find_first_opt: f:(elt -> bool) -> t -> elt option
+ (** [find_first_opt ~f s], where [f] is a monotonically increasing
+ function, returns an option containing the lowest element [e] of [s]
+ such that [f e], or [None] if no such element exists.
+ @since 4.05
+ *)
+
val find_last: f:(elt -> bool) -> t -> elt
+ (** [find_last ~f s], where [f] is a monotonically decreasing function,
+ returns the highest element [e] of [s] such that [f e],
+ or raises [Not_found] if no such element exists.
+ @since 4.05
+ *)
+
val find_last_opt: f:(elt -> bool) -> t -> elt option
+ (** [find_last_opt ~f s], where [f] is a monotonically decreasing
+ function, returns an option containing the highest element [e] of [s]
+ such that [f e], or [None] if no such element exists.
+ @since 4.05
+ *)
+
val of_list: elt list -> t
+ (** [of_list l] creates a set from a list of elements.
+ This is usually more efficient than folding [add] over the list,
+ except perhaps for lists with many duplicated elements.
+ @since 4.02.0 *)
+
+ (** {1 Iterators} *)
+
val to_seq_from : elt -> t -> elt Seq.t
+ (** [to_seq_from x s] iterates on a subset of the elements of [s]
+ in ascending order, from [x] or above.
+ @since 4.07 *)
+
val to_seq : t -> elt Seq.t
+ (** Iterate on the whole set, in ascending order
+ @since 4.07 *)
+
+ val to_rev_seq : t -> elt Seq.t
+ (** Iterate on the whole set, in descending order
+ @since 4.12 *)
+
val add_seq : elt Seq.t -> t -> t
+ (** Add the given elements to the set, in order.
+ @since 4.07 *)
+
val of_seq : elt Seq.t -> t
+ (** Build a set from the given bindings
+ @since 4.07 *)
end
- module Make : functor (Ord : OrderedType) -> S
+ (** Output signature of the functor {!Make}. *)
+
+ module Make : functor (Ord : OrderedType) -> S
with type elt = Ord.t
and type t = Set.Make(Ord).t
+ (** Functor building an implementation of the set structure
+ given a totally ordered type. *)
+
end
Literals for native integers are suffixed by n:
{[
- let zero: nativeint = 0n
- let one: nativeint = 1n
- let m_one: nativeint = -1n
+ let zero: nativeint = 0n
+ let one: nativeint = 1n
+ let m_one: nativeint = -1n
]}
*)
type t
+type raw_data = nativeint
+
external repr : 'a -> t = "%identity"
external obj : t -> 'a = "%identity"
external magic : 'a -> 'b = "%identity"
external is_int : t -> bool = "%obj_is_int"
let [@inline always] is_block a = not (is_int a)
-external tag : t -> int = "caml_obj_tag"
+external tag : t -> int = "caml_obj_tag" [@@noalloc]
external set_tag : t -> int -> unit = "caml_obj_set_tag"
external size : t -> int = "%obj_size"
external reachable_words : t -> int = "caml_obj_reachable_words"
let [@inline always] double_field x i = floatarray_get (obj x : floatarray) i
let [@inline always] set_double_field x i v =
floatarray_set (obj x : floatarray) i v
+external raw_field : t -> int -> raw_data = "caml_obj_raw_field"
+external set_raw_field : t -> int -> raw_data -> unit
+ = "caml_obj_set_raw_field"
+
external new_block : int -> int -> t = "caml_obj_block"
external dup : t -> t = "caml_obj_dup"
external truncate : t -> int -> unit = "caml_obj_truncate"
let out_of_heap_tag = 1001
let unaligned_tag = 1002
+module Closure = struct
+ type info = {
+ arity: int;
+ start_env: int;
+ }
+
+ let info_of_raw (info : nativeint) =
+ let open Nativeint in
+ let arity =
+ (* signed: negative for tupled functions *)
+ if Sys.word_size = 64 then
+ to_int (shift_right info 56)
+ else
+ to_int (shift_right info 24)
+ in
+ let start_env =
+ (* start_env is unsigned, but we know it can always fit an OCaml
+ integer so we use [to_int] instead of [unsigned_to_int]. *)
+ to_int (shift_right_logical (shift_left info 8) 9) in
+ { arity; start_env }
+
+ (* note: we expect a closure, not an infix pointer *)
+ let info (obj : t) =
+ assert (tag obj = closure_tag);
+ info_of_raw (raw_field obj 1)
+end
+
module Extension_constructor =
struct
type t = extension_constructor
type t
+type raw_data = nativeint (* @since 4.12 *)
+
external repr : 'a -> t = "%identity"
external obj : t -> 'a = "%identity"
external magic : 'a -> 'b = "%identity"
val [@inline always] is_block : t -> bool
external is_int : t -> bool = "%obj_is_int"
-external tag : t -> int = "caml_obj_tag"
+external tag : t -> int = "caml_obj_tag" [@@noalloc]
external size : t -> int = "%obj_size"
external reachable_words : t -> int = "caml_obj_reachable_words"
(**
Computes the total size (in words, including the headers) of all
heap blocks accessible from the argument. Statically
- allocated blocks are excluded.
+ allocated blocks are excluded, unless the runtime system
+ was configured with [--disable-naked-pointers].
@Since 4.04
*)
val [@inline always] double_field : t -> int -> float (* @since 3.11.2 *)
val [@inline always] set_double_field : t -> int -> float -> unit
(* @since 3.11.2 *)
+
+external raw_field : t -> int -> raw_data = "caml_obj_raw_field"
+ (* @since 4.12 *)
+external set_raw_field : t -> int -> raw_data -> unit
+ = "caml_obj_set_raw_field"
+ (* @since 4.12 *)
+
external new_block : int -> int -> t = "caml_obj_block"
external dup : t -> t = "caml_obj_dup"
external truncate : t -> int -> unit = "caml_obj_truncate"
val out_of_heap_tag : int
val unaligned_tag : int (* should never happen @since 3.11.0 *)
+module Closure : sig
+ type info = {
+ arity: int;
+ start_env: int;
+ }
+ val info : t -> info
+end
+
module Extension_constructor :
sig
type t = extension_constructor
(** {1:preds Predicates and comparisons} *)
val is_none : 'a option -> bool
-(** [is_none o] is [true] iff [o] is [None]. *)
+(** [is_none o] is [true] if and only if [o] is [None]. *)
val is_some : 'a option -> bool
-(** [is_some o] is [true] iff [o] is [Some o]. *)
+(** [is_some o] is [true] if and only if [o] is [Some o]. *)
val equal : ('a -> 'a -> bool) -> 'a option -> 'a option -> bool
-(** [equal eq o0 o1] is [true] iff [o0] and [o1] are both [None] or if
- they are [Some v0] and [Some v1] and [eq v0 v1] is [true]. *)
+(** [equal eq o0 o1] is [true] if and only if [o0] and [o1] are both [None]
+ or if they are [Some v0] and [Some v1] and [eq v0 v1] is [true]. *)
val compare : ('a -> 'a -> int) -> 'a option -> 'a option -> int
(** [compare cmp o0 o1] is a total order on options using [cmp] to compare
type t = exn = ..
-let printers = ref []
+let printers = Atomic.make []
let locfmt = format_of_string "File \"%s\", line %d, characters %d-%d: %s"
| None | exception _ -> conv tl
| Some s -> Some s)
| [] -> None in
- conv !printers
+ conv (Atomic.get printers)
let to_string_default = function
| Out_of_memory -> "Out of memory"
exit 2
type raw_backtrace_slot
-type raw_backtrace
+type raw_backtrace_entry = private int
+type raw_backtrace = raw_backtrace_entry array
+
+let raw_backtrace_entries bt = bt
external get_raw_backtrace:
unit -> raw_backtrace = "caml_get_exception_raw_backtrace"
then Some backtrace
else None
+let backtrace_slots_of_raw_entry entry =
+ backtrace_slots [| entry |]
+
module Slot = struct
type t = backtrace_slot
let format = format_backtrace_slot
let name = backtrace_slot_defname
end
-external raw_backtrace_length :
- raw_backtrace -> int = "caml_raw_backtrace_length" [@@noalloc]
+let raw_backtrace_length bt = Array.length bt
external get_raw_backtrace_slot :
raw_backtrace -> int -> raw_backtrace_slot = "caml_raw_backtrace_slot"
external record_backtrace: bool -> unit = "caml_record_backtrace"
external backtrace_status: unit -> bool = "caml_backtrace_status"
-let register_printer fn =
- printers := fn :: !printers
+let rec register_printer fn =
+ let old_printers = Atomic.get printers in
+ let new_printers = fn :: old_printers in
+ let success = Atomic.compare_and_set printers old_printers new_printers in
+ if not success then register_printer fn
external get_callstack: int -> raw_backtrace = "caml_get_current_callstack"
let slot = exn_slot x in
(Obj.obj (Obj.field slot 0) : string)
+external get_debug_info_status : unit -> int = "caml_ml_debug_info_status"
+
+(* Descriptions for errors in startup.h. See also backtrace.c *)
+let errors = [| "";
+ (* FILE_NOT_FOUND *)
+ "(Cannot print locations:\n \
+ bytecode executable program file not found)";
+ (* BAD_BYTECODE *)
+ "(Cannot print locations:\n \
+ bytecode executable program file appears to be corrupt)";
+ (* WRONG_MAGIC *)
+ "(Cannot print locations:\n \
+ bytecode executable program file has wrong magic number)";
+ (* NO_FDS *)
+ "(Cannot print locations:\n \
+ bytecode executable program file cannot be opened;\n \
+ -- too many open files. Try running with OCAMLRUNPARAM=b=2)"
+|]
+
let default_uncaught_exception_handler exn raw_backtrace =
eprintf "Fatal error: exception %s\n" (to_string exn);
print_raw_backtrace stderr raw_backtrace;
+ let status = get_debug_info_status () in
+ if status < 0 then
+ prerr_endline errors.(abs status);
flush stderr
let uncaught_exception_handler = ref default_uncaught_exception_handler
let set_uncaught_exception_handler fn = uncaught_exception_handler := fn
-let empty_backtrace : raw_backtrace = Obj.obj (Obj.new_block Obj.abstract_tag 0)
+let empty_backtrace : raw_backtrace = [| |]
let try_get_raw_backtrace () =
try
(** {1 Raw backtraces} *)
type raw_backtrace
-(** The abstract type [raw_backtrace] stores a backtrace in
- a low-level format, instead of directly exposing them as string as
- the [get_backtrace()] function does.
+(** The type [raw_backtrace] stores a backtrace in a low-level format,
+ which can be converted to usable form using [raw_backtrace_entries]
+ and [backtrace_slots_of_raw_entry] below.
- This allows delaying the formatting of backtraces to when they are
- actually printed, which may be useful if you record more
- backtraces than you print.
+ Converting backtraces to [backtrace_slot]s is slower than capturing the
+ backtraces. If an application processes many backtraces, it can be useful
+ to use [raw_backtrace] to avoid or delay conversion.
Raw backtraces cannot be marshalled. If you need marshalling, you
should use the array returned by the [backtrace_slots] function of
@since 4.01.0
*)
+type raw_backtrace_entry = private int
+(** A [raw_backtrace_entry] is an element of a [raw_backtrace].
+
+ Each [raw_backtrace_entry] is an opaque integer, whose value is not stable
+ between different programs, or even between different runs of the same
+ binary.
+
+ A [raw_backtrace_entry] can be converted to a usable form using
+ [backtrace_slots_of_raw_entry] below. Note that, due to inlining, a
+ single [raw_backtrace_entry] may convert to several [backtrace_slot]s.
+ Since the values of a [raw_backtrace_entry] are not stable, they cannot
+ be marshalled. If they are to be converted, the conversion must be done
+ by the process that generated them.
+
+ Again due to inlining, there may be multiple distinct raw_backtrace_entry
+ values that convert to equal [backtrace_slot]s. However, if two
+ [raw_backtrace_entry]s are equal as integers, then they represent the same
+ [backtrace_slot]s.
+
+ @since 4.12.0 *)
+
+val raw_backtrace_entries : raw_backtrace -> raw_backtrace_entry array
+(** @since 4.12.0 *)
+
val get_raw_backtrace: unit -> raw_backtrace
(** [Printexc.get_raw_backtrace ()] returns the same exception
backtrace that [Printexc.print_backtrace] would print, but in
@since 4.02.0
*)
+val backtrace_slots_of_raw_entry :
+ raw_backtrace_entry -> backtrace_slot array option
+(** Returns the slots of a single raw backtrace entry, or [None] if this
+ entry lacks debug information.
+
+ Slots are returned in the same order as [backtrace_slots]: the slot
+ at index [0] is the most recent call, raise, or primitive, and
+ subsequent slots represent callers.
+
+ @since 4.12
+*)
+
+
type location = {
filename : string;
line_number : int;
(** {1 Raw backtrace slots} *)
type raw_backtrace_slot
-(** This type allows direct access to raw backtrace slots, without any
- conversion in an OCaml-usable data-structure. Being
- process-specific, they must absolutely not be marshalled, and are
- unsafe to use for this reason (marshalling them may not fail, but
- un-marshalling and using the result will result in
- undefined behavior).
-
- Elements of this type can still be compared and hashed: when two
- elements are equal, then they represent the same source location
- (the converse is not necessarily true in presence of inlining,
- for example).
+(** This type is used to iterate over the slots of a [raw_backtrace].
+ For most purposes, [backtrace_slots_of_raw_entry] is easier to use.
+
+ Like [raw_backtrace_entry], values of this type are process-specific and
+ must absolutely not be marshalled, and are unsafe to use for this reason
+ (marshalling them may not fail, but un-marshalling and using the result
+ will result in undefined behavior).
+
+ Elements of this type can still be compared and hashed: when two elements
+ are equal, then they represent the same source location (the converse is not
+ necessarily true in presence of inlining, for example).
@since 4.02.0
*)
Failure to do so can lead to a crash.
*)
-type 'a t
+type !'a t
(** The type of queues containing elements of type ['a]. *)
(** {1:preds Predicates and comparisons} *)
val is_ok : ('a, 'e) result -> bool
-(** [is_ok r] is [true] iff [r] is [Ok _]. *)
+(** [is_ok r] is [true] if and only if [r] is [Ok _]. *)
val is_error : ('a, 'e) result -> bool
-(** [is_error r] is [true] iff [r] is [Error _]. *)
+(** [is_error r] is [true] if and only if [r] is [Error _]. *)
val equal :
ok:('a -> 'a -> bool) -> error:('e -> 'e -> bool) -> ('a, 'e) result ->
(* *)
(**************************************************************************)
-(* Module [Seq]: functional iterators *)
+(** Functional iterators.
-(** {1 Functional Iterators} *)
+ 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.
-(** The type ['a 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.
+ @since 4.07
*)
-(** @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,
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
let to_seq c = seq_of_enum_ (cons_enum c End)
+ let rec snoc_enum s e =
+ match s with
+ Empty -> e
+ | Node{l; v; r} -> snoc_enum r (More(v, l, e))
+
+ let rec rev_seq_of_enum_ c () = match c with
+ | End -> Seq.Nil
+ | More (x, t, rest) -> Seq.Cons (x, rev_seq_of_enum_ (snoc_enum t rest))
+
+ let to_rev_seq c = rev_seq_of_enum_ (snoc_enum c End)
+
let to_seq_from low s =
let rec aux low s c = match s with
| Empty -> c
(* *)
(**************************************************************************)
+(* NOTE: If this file is set.mli, do not edit it directly! Instead,
+ edit templates/set.template.mli and run tools/sync_stdlib_docs *)
+
(** Sets over ordered types.
This module implements the set data structure, given a total ordering
Example: a suitable ordering function is the generic structural
comparison function {!Stdlib.compare}. *)
end
-(** Input signature of the functor {!Set.Make}. *)
+(** Input signature of the functor {!Make}. *)
module type S =
sig
@since 4.04.0 *)
val fold: (elt -> 'a -> 'a) -> t -> 'a -> 'a
- (** [fold f s a] computes [(f xN ... (f x2 (f x1 a))...)],
+ (** [fold f s init] computes [(f xN ... (f x2 (f x1 init))...)],
where [x1 ... xN] are the elements of [s], in increasing order. *)
val for_all: (elt -> bool) -> t -> bool
- (** [for_all p s] checks if all elements of the set
- satisfy the predicate [p]. *)
+ (** [for_all f s] checks if all elements of the set
+ satisfy the predicate [f]. *)
val exists: (elt -> bool) -> t -> bool
- (** [exists p s] checks if at least one element of
- the set satisfies the predicate [p]. *)
+ (** [exists f s] checks if at least one element of
+ the set satisfies the predicate [f]. *)
val filter: (elt -> bool) -> t -> t
- (** [filter p s] returns the set of all elements in [s]
- that satisfy predicate [p]. If [p] satisfies every element in [s],
+ (** [filter f s] returns the set of all elements in [s]
+ that satisfy predicate [f]. If [f] satisfies every element in [s],
[s] is returned unchanged (the result of the function is then
physically equal to [s]).
@before 4.03 Physical equality was not ensured.*)
*)
val partition: (elt -> bool) -> t -> t * t
- (** [partition p s] returns a pair of sets [(s1, s2)], where
+ (** [partition f s] returns a pair of sets [(s1, s2)], where
[s1] is the set of all the elements of [s] that satisfy the
- predicate [p], and [s2] is the set of all the elements of
- [s] that do not satisfy [p]. *)
+ predicate [f], and [s2] is the set of all the elements of
+ [s] that do not satisfy [f]. *)
val cardinal: t -> int
(** Return the number of elements of a set. *)
(** 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 {!Set.Make}. *)
+ given to {!Make}. *)
val min_elt: t -> elt
(** Return the smallest element of the given set
*)
val max_elt: t -> elt
- (** Same as {!Set.S.min_elt}, but returns the largest element of the
+ (** Same as {!S.min_elt}, but returns the largest element of the
given set. *)
val max_elt_opt: t -> elt option
- (** Same as {!Set.S.min_elt_opt}, but returns the largest element of the
+ (** Same as {!S.min_elt_opt}, but returns the largest element of the
given set.
@since 4.05
*)
*)
val find_first_opt: (elt -> bool) -> t -> elt option
- (** [find_first_opt f s], where [f] is a monotonically increasing function,
- returns an option containing the lowest element [e] of [s] such that
- [f e], or [None] if no such element exists.
+ (** [find_first_opt f s], where [f] is a monotonically increasing
+ function, returns an option containing the lowest element [e] of [s]
+ such that [f e], or [None] if no such element exists.
@since 4.05
*)
*)
val find_last_opt: (elt -> bool) -> t -> elt option
- (** [find_last_opt f s], where [f] is a monotonically decreasing function,
- returns an option containing the highest element [e] of [s] such that
- [f e], or [None] if no such element exists.
+ (** [find_last_opt f s], where [f] is a monotonically decreasing
+ function, returns an option containing the highest element [e] of [s]
+ such that [f e], or [None] if no such element exists.
@since 4.05
*)
(** Iterate on the whole set, in ascending order
@since 4.07 *)
+ val to_rev_seq : t -> elt Seq.t
+ (** Iterate on the whole set, in descending order
+ @since 4.12 *)
+
val add_seq : elt Seq.t -> t -> t
(** Add the given elements to the set, in order.
@since 4.07 *)
(** Build a set from the given bindings
@since 4.07 *)
end
-(** Output signature of the functor {!Set.Make}. *)
+(** Output signature of the functor {!Make}. *)
module Make (Ord : OrderedType) : S with type elt = Ord.t
(** Functor building an implementation of the set structure
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Mark Shinwell and Leo White, Jane Street Europe *)
-(* *)
-(* Copyright 2015--2016 Jane Street Group LLC *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-external spacetime_enabled : unit -> bool
- = "caml_spacetime_enabled" [@@noalloc]
-
-let enabled = spacetime_enabled ()
-
-let if_spacetime_enabled f =
- if enabled then f () else ()
-
-module Series = struct
- type t = {
- channel : out_channel;
- mutable closed : bool;
- }
-
- external write_magic_number : out_channel -> unit
- = "caml_spacetime_only_works_for_native_code"
- "caml_spacetime_write_magic_number"
-
- external register_channel_for_spacetime : out_channel -> unit
- = "caml_register_channel_for_spacetime"
-
- let create ~path =
- if spacetime_enabled () then begin
- let channel = open_out path in
- register_channel_for_spacetime channel;
- let t =
- { channel = channel;
- closed = false;
- }
- in
- write_magic_number t.channel;
- t
- end else begin
- { channel = stdout; (* arbitrary value *)
- closed = true;
- }
- end
-
- external save_event : ?time:float -> out_channel -> event_name:string -> unit
- = "caml_spacetime_only_works_for_native_code"
- "caml_spacetime_save_event"
-
- let save_event ?time t ~event_name =
- if_spacetime_enabled (fun () ->
- save_event ?time t.channel ~event_name)
-
- external save_trie : ?time:float -> out_channel -> unit
- = "caml_spacetime_only_works_for_native_code"
- "caml_spacetime_save_trie"
-
- let save_and_close ?time t =
- if_spacetime_enabled (fun () ->
- if t.closed then failwith "Series is closed";
- save_trie ?time t.channel;
- close_out t.channel;
- t.closed <- true)
-end
-
-module Snapshot = struct
- external take : ?time:float -> out_channel -> unit
- = "caml_spacetime_only_works_for_native_code"
- "caml_spacetime_take_snapshot"
-
- let take ?time { Series.closed; channel } =
- if_spacetime_enabled (fun () ->
- if closed then failwith "Series is closed";
- Gc.minor ();
- take ?time channel)
-end
-
-external save_event_for_automatic_snapshots : event_name:string -> unit
- = "caml_spacetime_only_works_for_native_code"
- "caml_spacetime_save_event_for_automatic_snapshots"
-
-let save_event_for_automatic_snapshots ~event_name =
- if_spacetime_enabled (fun () ->
- save_event_for_automatic_snapshots ~event_name)
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Mark Shinwell and Leo White, Jane Street Europe *)
-(* *)
-(* Copyright 2015--2016 Jane Street Group LLC *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-(** Profiling of a program's space behaviour over time.
- Currently only supported on x86-64 platforms running 64-bit code.
-
- To use the functions in this module you must:
- - configure the compiler with "-spacetime";
- - compile to native code.
- Without these conditions being satisfied the functions in this module
- will have no effect.
-
- Instead of manually taking profiling heap snapshots with this module it is
- possible to use an automatic snapshot facility that writes profiling
- information at fixed intervals to a file. To enable this, all that needs to
- be done is to build the relevant program using a compiler configured with
- -spacetime; and set the environment variable OCAML_SPACETIME_INTERVAL to an
- integer number of milliseconds giving the interval between profiling heap
- snapshots. This interval should not be made excessively small relative to
- the running time of the program. A typical interval to start with might be
- 1/100 of the running time of the program. The program must exit "normally"
- (i.e. by calling [exit], with whatever exit code, rather than being
- abnormally terminated by a signal) so that the snapshot file is
- correctly completed.
-
- When using the automatic snapshot mode the profiling output is written
- to a file called "spacetime-<pid>" where <pid> is the process ID of the
- program. (If the program forks and continues executing then multiple
- files may be produced with different pid numbers.) The profiling output
- is by default written to the current working directory when the program
- starts. This may be customised by setting the OCAML_SPACETIME_SNAPSHOT_DIR
- environment variable to the name of the desired directory.
-
- If using automatic snapshots the presence of the
- [save_event_for_automatic_snapshots] function, below, should be noted.
-
- The functions in this module are thread safe.
-
- For functions to decode the information recorded by the profiler,
- see the Spacetime offline library in otherlibs/. *)
-
-(** [enabled] is [true] if the compiler is configured with spacetime and [false]
- otherwise *)
-val enabled : bool
-
-module Series : sig
- (** Type representing a file that will hold a series of heap snapshots
- together with additional information required to interpret those
- snapshots. *)
- type t
-
- (** [create ~path] creates a series file at [path]. *)
- val create : path:string -> t
-
- (** [save_event] writes an event, which is an arbitrary string, into the
- given series file. This may be used for identifying particular points
- during program execution when analysing the profile.
- The optional [time] parameter is as for {!Snapshot.take}.
- *)
- val save_event : ?time:float -> t -> event_name:string -> unit
-
- (** [save_and_close series] writes information into [series] required for
- interpreting the snapshots that [series] contains and then closes the
- [series] file. This function must be called to produce a valid series
- file.
- The optional [time] parameter is as for {!Snapshot.take}.
- *)
- val save_and_close : ?time:float -> t -> unit
-end
-
-module Snapshot : sig
- (** [take series] takes a snapshot of the profiling annotations on the values
- in the minor and major heaps, together with GC stats, and write the
- result to the [series] file. This function triggers a minor GC but does
- not allocate any memory itself.
- If the optional [time] is specified, it will be used instead of the
- result of {!Sys.time} as the timestamp of the snapshot. Such [time]s
- should start from zero and be monotonically increasing. This parameter
- is intended to be used so that snapshots can be correlated against wall
- clock time (which is not supported in the standard library) rather than
- elapsed CPU time.
- *)
- val take : ?time:float -> Series.t -> unit
-end
-
-(** Like {!Series.save_event}, but writes to the automatic snapshot file.
- This function is a no-op if OCAML_SPACETIME_INTERVAL was not set. *)
-val save_event_for_automatic_snapshots : event_name:string -> unit
This module implements stacks (LIFOs), with in-place modification.
*)
-type 'a t
+type !'a t
(** The type of stacks containing elements of type ['a]. *)
exception Empty
(** Standard labeled libraries.
- This meta-module provides labelized version of the {!Array},
- {!Bytes}, {!List} and {!String} modules.
+ This meta-module provides versions of the {!Array}, {!Bytes},
+ {!List} and {!String} modules where function arguments are
+ systematically labeled. It is intended to be opened at the top of
+ source files, as shown below.
+
+ {[
+ open StdLabels
+
+ let to_upper = String.map ~f:Char.uppercase_ascii
+ let seq len = List.init ~f:(function i -> i) ~len
+ let everything = Array.create_matrix ~dimx:42 ~dimy:42 42
+ ]}
- They only differ by their labels. Detailed interfaces can be found
- in [arrayLabels.mli], [bytesLabels.mli], [listLabels.mli]
- and [stringLabels.mli].
*)
module Array = ArrayLabels
external __LINE__ : int = "%loc_LINE"
external __MODULE__ : string = "%loc_MODULE"
external __POS__ : string * int * int * int = "%loc_POS"
+external __FUNCTION__ : string = "%loc_FUNCTION"
external __LOC_OF__ : 'a -> string * 'a = "%loc_LOC"
external __LINE_OF__ : 'a -> int * 'a = "%loc_LINE"
external sys_exit : int -> 'a = "caml_sys_exit"
-let exit_function = ref flush_all
+let exit_function = CamlinternalAtomic.make flush_all
-let at_exit f =
- let g = !exit_function in
+let rec at_exit f =
+ let module Atomic = CamlinternalAtomic in
(* MPR#7253, MPR#7796: make sure "f" is executed only once *)
- let f_already_ran = ref false in
- exit_function :=
- (fun () ->
- if not !f_already_ran then begin f_already_ran := true; f() end;
- g())
+ let f_yet_to_run = Atomic.make true in
+ let old_exit = Atomic.get exit_function in
+ let new_exit () =
+ if Atomic.compare_and_set f_yet_to_run true false then f () ;
+ old_exit ()
+ in
+ let success = Atomic.compare_and_set exit_function old_exit new_exit in
+ if not success then at_exit f
-let do_at_exit () = (!exit_function) ()
+let do_at_exit () = (CamlinternalAtomic.get exit_function) ()
let exit retcode =
do_at_exit ();
let _ = register_named_value "Pervasives.do_at_exit" do_at_exit
+external major : unit -> unit = "caml_gc_major"
+external naked_pointers_checked : unit -> bool
+ = "caml_sys_const_naked_pointers_checked"
+let () = if naked_pointers_checked () then at_exit major
+
(*MODULE_ALIASES*)
module Arg = Arg
module Array = Array
module ArrayLabels = ArrayLabels
+module Atomic = Atomic
module Bigarray = Bigarray
module Bool = Bool
module Buffer = Buffer
module Char = Char
module Complex = Complex
module Digest = Digest
+module Either = Either
module Ephemeron = Ephemeron
module Filename = Filename
module Float = Float
module Scanf = Scanf
module Seq = Seq
module Set = Set
-module Spacetime = Spacetime
module Stack = Stack
module StdLabels = StdLabels
module Stream = Stream
@since 4.02.0
*)
+external __FUNCTION__ : string = "%loc_FUNCTION"
+(** [__FUNCTION__] returns the name of the current function or method, including
+ any enclosing modules or classes.
+
+ @since 4.12.0 *)
+
external __LOC_OF__ : 'a -> string * 'a = "%loc_LOC"
(** [__LOC_OF__ expr] returns a pair [(loc, expr)] where [loc] is the
location of [expr] in the file currently being parsed by the
[neg_infinity] for [-1.0 /. 0.0], and [nan] ('not a number')
for [0.0 /. 0.0]. These special numbers then propagate through
floating-point computations as expected: for instance,
- [1.0 /. infinity] is [0.0], and any arithmetic operation with [nan]
- as argument returns [nan] as result.
+ [1.0 /. infinity] is [0.0], basic arithmetic operations
+ ([+.], [-.], [*.], [/.]) with [nan] as an argument return [nan], ...
*)
external ( ~-. ) : float -> float = "%negfloat"
val pos_out : out_channel -> int
(** Return the current writing position for the given channel. Does
not work on channels opened with the [Open_append] flag (returns
- unspecified results). *)
+ 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_out], then going back to
+ this position using [seek_out] will not work. For this
+ programming idiom to work reliably and portably, the file must be
+ opened in binary mode. *)
val out_channel_length : out_channel -> int
(** Return the size (number of characters) of the regular file
files of other kinds, the behavior is unspecified. *)
val pos_in : in_channel -> int
-(** Return the current reading position for the given channel. *)
+(** 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_in], then going back to this
+ position using [seek_in] will not work. For this programming
+ idiom to work reliably and portably, the file must be opened in
+ binary mode. *)
val in_channel_length : in_channel -> int
(** Return the size (number of characters) of the regular file
module Arg = Arg
module Array = Array
module ArrayLabels = ArrayLabels
+module Atomic = Atomic
module Bigarray = Bigarray
module Bool = Bool
module Buffer = Buffer
module Char = Char
module Complex = Complex
module Digest = Digest
+module Either = Either
module Ephemeron = Ephemeron
module Filename = Filename
module Float = Float
module Scanf = Scanf
module Seq = Seq
module Set = Set
-module Spacetime = Spacetime
module Stack = Stack
module StdLabels = StdLabels
module Stream = Stream
(** Streams and parsers. *)
-type 'a t
+type !'a t
(** The type of streams holding values of type ['a]. *)
exception Failure
let uncapitalize_ascii s =
B.uncapitalize_ascii (bos s) |> bts
-type t = string
-
-let compare (x: t) (y: t) = Stdlib.compare x y
-external equal : string -> string -> bool = "caml_string_equal" [@@noalloc]
-
let split_on_char sep s =
let r = ref [] in
let j = ref (length s) in
let uncapitalize s =
B.uncapitalize (bos s) |> bts
+type t = string
+
+let compare (x: t) (y: t) = Stdlib.compare x y
+external equal : string -> string -> bool = "caml_string_equal" [@@noalloc]
+
(** {1 Iterators} *)
let to_seq s = bos s |> B.to_seq
(* *)
(**************************************************************************)
-(** String operations.
-
- A string is an immutable data structure that contains a
- fixed-length sequence of (single-byte) characters. Each character
- can be accessed in constant time through its index.
-
- Given a string [s] of length [l], we can access each of the [l]
- characters of [s] via its index in the sequence. Indexes start at
- [0], and we will call an index valid in [s] if it falls within the
- range [[0...l-1]] (inclusive). A position is the point between two
- characters or at the beginning or end of the string. We call a
- position valid in [s] if it falls within the range [[0...l]]
- (inclusive). Note that the character at index [n] is between
- positions [n] and [n+1].
-
- Two parameters [start] and [len] are said to designate a valid
- substring of [s] if [len >= 0] and [start] and [start+len] are
- valid positions in [s].
-
- Note: OCaml strings used to be modifiable in place, for instance via
- the {!String.set} and {!String.blit} functions described below. This
- usage is only possible when the compiler is put in "unsafe-string"
- mode by giving the [-unsafe-string] command-line option. This
- compatibility mode makes the types [string] and [bytes] (see module
- {!Bytes}) interchangeable so that functions expecting byte sequences
- can also accept strings as arguments and modify them.
-
- The distinction between [bytes] and [string] was introduced in OCaml
- 4.02, and the "unsafe-string" compatibility mode was the default
- until OCaml 4.05. Starting with 4.06, the compatibility mode is
- opt-in; we intend to remove the option in the future.
+(* NOTE:
+ If this file is stringLabels.mli, run tools/sync_stdlib_docs after editing
+ it to generate string.mli.
+
+ If this file is string.mli, do not edit it directly -- edit
+ stringLabels.mli instead.
+ *)
+
+(** Strings.
+
+ A string [s] of length [n] is an indexable and immutable sequence
+ of [n] bytes. For historical reasons these bytes are referred to
+ as characters.
+
+ The semantics of string functions is defined in terms of
+ indices and positions. These are depicted and described
+ as follows.
+
+{v
+positions 0 1 2 3 4 n-1 n
+ +---+---+---+---+ +-----+
+ indices | 0 | 1 | 2 | 3 | ... | n-1 |
+ +---+---+---+---+ +-----+
+v}
+ {ul
+ {- An {e index} [i] of [s] is an integer in the range \[[0];[n-1]\].
+ It represents the [i]th byte (character) of [s] which can be
+ accessed using the constant time string indexing operator
+ [s.[i]].}
+ {- A {e position} [i] of [s] is an integer in the range
+ \[[0];[n]\]. It represents either the point at the beginning of
+ the string, or the point between two indices, or the point at
+ the end of the string. The [i]th byte index is between position
+ [i] and [i+1].}}
+
+ Two integers [start] and [len] are said to define a {e valid
+ substring} of [s] if [len >= 0] and [start], [start+len] are
+ positions of [s].
+
+ {b Unicode text.} Strings being arbitrary sequences of bytes, they
+ can hold any kind of textual encoding. However the recommended
+ encoding for storing Unicode text in OCaml strings is UTF-8. This
+ is the encoding used by Unicode escapes in string literals. For
+ example the string ["\u{1F42B}"] is the UTF-8 encoding of the
+ Unicode character U+1F42B.
+
+ {b Past mutability.} OCaml strings used to be modifiable in place,
+ for instance via the {!String.set} and {!String.blit}
+ functions. This use is nowadays only possible when the compiler is
+ put in "unsafe-string" mode by giving the [-unsafe-string]
+ command-line option. This compatibility mode makes the types
+ [string] and [bytes] (see {!Bytes.t}) interchangeable so that
+ functions expecting byte sequences can also accept strings as
+ arguments and modify them.
+
+ The distinction between [bytes] and [string] was introduced in
+ OCaml 4.02, and the "unsafe-string" compatibility mode was the
+ default until OCaml 4.05. Starting with 4.06, the compatibility
+ mode is opt-in; we intend to remove the option in the future.
+
+ The labeled version of this module can be used as described in the
+ {!StdLabels} module.
*)
+(** {1:strings Strings} *)
+
+type t = string
+(** The type for strings. *)
+
+val make : int -> char -> string
+(** [make n c] is a string of length [n] with each index holding the
+ character [c].
+
+ @raise Invalid_argument if [n < 0] or [n > ]{!Sys.max_string_length}. *)
+
+val init : int -> (int -> char) -> string
+(** [init n f] is a string of length [n] with index
+ [i] holding the character [f i] (called in increasing index order).
+
+ @raise Invalid_argument if [n < 0] or [n > ]{!Sys.max_string_length}.
+ @since 4.02.0 *)
+
external length : string -> int = "%string_length"
-(** Return the length (number of characters) of the given string. *)
+(** [length s] is the length (number of bytes/characters) of [s]. *)
external get : string -> int -> char = "%string_safe_get"
-(** [String.get s n] returns the character at index [n] in string [s].
- You can also write [s.[n]] instead of [String.get s n].
- @raise Invalid_argument if [n] not a valid index in [s]. *)
+(** [get s i] is the character at index [i] in [s]. This is the same
+ as writing [s.[i]].
+ @raise Invalid_argument if [i] not an index of [s]. *)
-external set : bytes -> int -> char -> unit = "%string_safe_set"
- [@@ocaml.deprecated "Use Bytes.set instead."]
-(** [String.set s n c] modifies byte sequence [s] in place,
- replacing the byte at index [n] with [c].
- You can also write [s.[n] <- c] instead of [String.set s n c].
- @raise Invalid_argument if [n] is not a valid index in [s].
+(** {1:concat Concatenating}
- @deprecated This is a deprecated alias of {!Bytes.set}.[ ] *)
+ {b Note.} The {!Stdlib.( ^ )} binary operator concatenates two
+ strings. *)
-external create : int -> bytes = "caml_create_string"
- [@@ocaml.deprecated "Use Bytes.create instead."]
-(** [String.create n] returns a fresh byte sequence of length [n].
- The sequence is uninitialized and contains arbitrary bytes.
- @raise Invalid_argument if [n < 0] or [n > ]{!Sys.max_string_length}.
+val concat : string -> string list -> string
+(** [concat sep ss] concatenates the list of strings [ss], inserting
+ the separator string [sep] between each.
- @deprecated This is a deprecated alias of {!Bytes.create}.[ ] *)
+ @raise Invalid_argument if the result is longer than
+ {!Sys.max_string_length} bytes. *)
-val make : int -> char -> string
-(** [String.make n c] returns a fresh string of length [n],
- filled with the character [c].
- @raise Invalid_argument if [n < 0] or [n > ]{!Sys.max_string_length}. *)
+(** {1:predicates Predicates and comparisons} *)
-val init : int -> (int -> char) -> string
-(** [String.init n f] returns a string of length [n], with character
- [i] initialized to the result of [f i] (called in increasing
- index order).
+val equal : t -> t -> bool
+(** [equal s0 s1] is [true] if and only if [s0] and [s1] are character-wise
+ equal.
+ @since 4.03.0 (4.05.0 in StringLabels) *)
- @raise Invalid_argument if [n < 0] or [n > ]{!Sys.max_string_length}.
- @since 4.02.0
-*)
+val compare : t -> t -> int
+(** [compare s0 s1] sorts [s0] and [s1] in lexicographical order. [compare]
+ behaves like {!Stdlib.compare} on strings but may be more efficient. *)
-val copy : string -> string [@@ocaml.deprecated]
-(** Return a copy of the given string.
+val contains_from : string -> int -> char -> bool
+(** [contains_from s start c] is [true] if and only if [c] appears in [s]
+ after position [start].
- @deprecated Because strings are immutable, it doesn't make much
- sense to make identical copies of them. *)
+ @raise Invalid_argument if [start] is not a valid position in [s]. *)
-val sub : string -> int -> int -> string
-(** [String.sub s start len] returns a fresh string of length [len],
- containing the substring of [s] that starts at position [start] and
- has length [len].
- @raise Invalid_argument if [start] and [len] do not
- designate a valid substring of [s]. *)
+val rcontains_from : string -> int -> char -> bool
+(** [rcontains_from s stop c] is [true] if and only if [c] appears in [s]
+ before position [stop+1].
-val fill : bytes -> int -> int -> char -> unit
- [@@ocaml.deprecated "Use Bytes.fill instead."]
-(** [String.fill s start len c] modifies byte sequence [s] in place,
- replacing [len] bytes with [c], starting at [start].
- @raise Invalid_argument if [start] and [len] do not
- designate a valid range of [s].
+ @raise Invalid_argument if [stop < 0] or [stop+1] is not a valid
+ position in [s]. *)
- @deprecated This is a deprecated alias of {!Bytes.fill}.[ ] *)
+val contains : string -> char -> bool
+(** [contains s c] is {!String.contains_from}[ s 0 c]. *)
-val blit : string -> int -> bytes -> int -> int -> unit
-(** Same as {!Bytes.blit_string}. *)
+(** {1:extract Extracting substrings} *)
-val concat : string -> string list -> string
-(** [String.concat sep sl] concatenates the list of strings [sl],
- inserting the separator string [sep] between each.
- @raise Invalid_argument if the result is longer than
- {!Sys.max_string_length} bytes. *)
+val sub : string -> int -> int -> string
+(** [sub s pos len] is a string of length [len], containing the
+ substring of [s] that starts at position [pos] and has length
+ [len].
-val iter : (char -> unit) -> string -> unit
-(** [String.iter f s] applies function [f] in turn to all
- the characters of [s]. It is equivalent to
- [f s.[0]; f s.[1]; ...; f s.[String.length s - 1]; ()]. *)
+ @raise Invalid_argument if [pos] and [len] do not designate a valid
+ substring of [s]. *)
-val iteri : (int -> char -> unit) -> string -> unit
-(** Same as {!String.iter}, but the
- function is applied to the index of the element as first argument
- (counting from 0), and the character itself as second argument.
- @since 4.00.0 *)
+val split_on_char : char -> string -> string list
+(** [split_on_char sep s] is the list of all (possibly empty)
+ substrings of [s] that are delimited by the character [sep].
+
+ The function's result is specified by the following invariants:
+ {ul
+ {- The list is not empty.}
+ {- Concatenating its elements using [sep] as a separator returns a
+ string equal to the input ([concat (make 1 sep)
+ (split_on_char sep s) = s]).}
+ {- No string in the result contains the [sep] character.}}
+
+ @since 4.04.0 (4.05.0 in StringLabels) *)
+
+(** {1:transforming Transforming} *)
val map : (char -> char) -> string -> string
-(** [String.map f s] applies function [f] in turn to all the
- characters of [s] (in increasing index order) and stores the
- results in a new string that is returned.
+(** [map f s] is the string resulting from applying [f] to all the
+ characters of [s] in increasing order.
+
@since 4.00.0 *)
val mapi : (int -> char -> char) -> string -> string
-(** [String.mapi f s] calls [f] with each character of [s] and its
- index (in increasing index order) and stores the results in a new
- string that is returned.
+(** [mapi f s] is like {!map} but the index of the character is also
+ passed to [f].
+
@since 4.02.0 *)
val trim : string -> string
-(** Return a copy of the argument, without leading and trailing
- whitespace. The characters regarded as whitespace are: [' '],
- ['\012'], ['\n'], ['\r'], and ['\t']. If there is neither leading nor
- trailing whitespace character in the argument, return the original
- string itself, not a copy.
- @since 4.00.0 *)
+(** [trim s] is [s] without leading and trailing whitespace. Whitespace
+ characters are: [' '], ['\x0C'] (form feed), ['\n'], ['\r'], and ['\t'].
+
+ @since 4.00.0 *)
val escaped : string -> string
-(** Return a copy of the argument, with special characters
- represented by escape sequences, following the lexical
- conventions of OCaml.
- All characters outside the ASCII printable range (32..126) are
- escaped, as well as backslash and double-quote.
-
- If there is no special character in the argument that needs
- escaping, return the original string itself, not a copy.
- @raise Invalid_argument if the result is longer than
- {!Sys.max_string_length} bytes.
+(** [escaped s] is [s] with special characters represented by escape
+ sequences, following the lexical conventions of OCaml.
+
+ All characters outside the US-ASCII printable range \[0x20;0x7E\] are
+ escaped, as well as backslash (0x2F) and double-quote (0x22).
The function {!Scanf.unescaped} is a left inverse of [escaped],
i.e. [Scanf.unescaped (escaped s) = s] for any string [s] (unless
- [escape s] fails). *)
+ [escaped s] fails).
-val index : string -> char -> int
-(** [String.index s c] returns the index of the first
- occurrence of character [c] in string [s].
- @raise Not_found if [c] does not occur in [s]. *)
-
-val index_opt: string -> char -> int option
-(** [String.index_opt s c] returns the index of the first
- occurrence of character [c] in string [s], or
- [None] if [c] does not occur in [s].
- @since 4.05 *)
+ @raise Invalid_argument if the result is longer than
+ {!Sys.max_string_length} bytes. *)
-val rindex : string -> char -> int
-(** [String.rindex s c] returns the index of the last
- occurrence of character [c] in string [s].
- @raise Not_found if [c] does not occur in [s]. *)
-
-val rindex_opt: string -> char -> int option
-(** [String.rindex_opt s c] returns the index of the last occurrence
- of character [c] in string [s], or [None] if [c] does not occur in
- [s].
- @since 4.05 *)
+val uppercase_ascii : string -> string
+(** [uppercase_ascii s] is [s] with all lowercase letters
+ translated to uppercase, using the US-ASCII character set.
-val index_from : string -> int -> char -> int
-(** [String.index_from s i c] returns the index of the
- first occurrence of character [c] in string [s] after position [i].
- [String.index s c] is equivalent to [String.index_from s 0 c].
- @raise Invalid_argument if [i] is not a valid position in [s].
- @raise Not_found if [c] does not occur in [s] after position [i]. *)
-
-val index_from_opt: string -> int -> char -> int option
-(** [String.index_from_opt s i c] returns the index of the
- first occurrence of character [c] in string [s] after position [i]
- or [None] if [c] does not occur in [s] after position [i].
-
- [String.index_opt s c] is equivalent to [String.index_from_opt s 0 c].
- @raise Invalid_argument if [i] is not a valid position in [s].
+ @since 4.03.0 (4.05.0 in StringLabels) *)
- @since 4.05
-*)
+val lowercase_ascii : string -> string
+(** [lowercase_ascii s] is [s] with all uppercase letters translated
+ to lowercase, using the US-ASCII character set.
-val rindex_from : string -> int -> char -> int
-(** [String.rindex_from s i c] returns the index of the
- last occurrence of character [c] in string [s] before position [i+1].
- [String.rindex s c] is equivalent to
- [String.rindex_from s (String.length s - 1) c].
- @raise Invalid_argument if [i+1] is not a valid position in [s].
- @raise Not_found if [c] does not occur in [s] before position [i+1]. *)
-
-val rindex_from_opt: string -> int -> char -> int option
-(** [String.rindex_from_opt s i c] returns the index of the
- last occurrence of character [c] in string [s] before position [i+1]
- or [None] if [c] does not occur in [s] before position [i+1].
-
- [String.rindex_opt s c] is equivalent to
- [String.rindex_from_opt s (String.length s - 1) c].
- @raise Invalid_argument if [i+1] is not a valid position in [s].
-
- @since 4.05
-*)
+ @since 4.03.0 (4.05.0 in StringLabels) *)
-val contains : string -> char -> bool
-(** [String.contains s c] tests if character [c]
- appears in the string [s]. *)
+val capitalize_ascii : string -> string
+(** [capitalize_ascii s] is [s] with the first character set to
+ uppercase, using the US-ASCII character set.
-val contains_from : string -> int -> char -> bool
-(** [String.contains_from s start c] tests if character [c]
- appears in [s] after position [start].
- [String.contains s c] is equivalent to
- [String.contains_from s 0 c].
- @raise Invalid_argument if [start] is not a valid position in [s]. *)
+ @since 4.03.0 (4.05.0 in StringLabels) *)
-val rcontains_from : string -> int -> char -> bool
-(** [String.rcontains_from s stop c] tests if character [c]
- appears in [s] before position [stop+1].
- @raise Invalid_argument if [stop < 0] or [stop+1] is not a valid
- position in [s]. *)
+val uncapitalize_ascii : string -> string
+(** [uncapitalize_ascii s] is [s] with the first character set to lowercase,
+ using the US-ASCII character set.
-val uppercase : string -> string
- [@@ocaml.deprecated "Use String.uppercase_ascii instead."]
-(** Return a copy of the argument, with all lowercase letters
- translated to uppercase, including accented letters of the ISO
- Latin-1 (8859-1) character set.
- @deprecated Functions operating on Latin-1 character set are deprecated. *)
+ @since 4.03.0 (4.05.0 in StringLabels) *)
-val lowercase : string -> string
- [@@ocaml.deprecated "Use String.lowercase_ascii instead."]
-(** Return a copy of the argument, with all uppercase letters
- translated to lowercase, including accented letters of the ISO
- Latin-1 (8859-1) character set.
- @deprecated Functions operating on Latin-1 character set are deprecated. *)
+(** {1:traversing Traversing} *)
-val capitalize : string -> string
- [@@ocaml.deprecated "Use String.capitalize_ascii instead."]
-(** Return a copy of the argument, with the first character set to uppercase,
- using the ISO Latin-1 (8859-1) character set..
- @deprecated Functions operating on Latin-1 character set are deprecated. *)
+val iter : (char -> unit) -> string -> unit
+(** [iter f s] applies function [f] in turn to all the characters of [s].
+ It is equivalent to [f s.[0]; f s.[1]; ...; f s.[length s - 1]; ()]. *)
-val uncapitalize : string -> string
- [@@ocaml.deprecated "Use String.uncapitalize_ascii instead."]
-(** Return a copy of the argument, with the first character set to lowercase,
- using the ISO Latin-1 (8859-1) character set..
- @deprecated Functions operating on Latin-1 character set are deprecated. *)
+val iteri : (int -> char -> unit) -> string -> unit
+(** [iteri] is like {!iter}, but the function is also given the
+ corresponding character index.
-val uppercase_ascii : string -> string
-(** Return a copy of the argument, with all lowercase letters
- translated to uppercase, using the US-ASCII character set.
- @since 4.03.0 *)
+ @since 4.00.0 *)
-val lowercase_ascii : string -> string
-(** Return a copy of the argument, with all uppercase letters
- translated to lowercase, using the US-ASCII character set.
- @since 4.03.0 *)
+(** {1:searching Searching} *)
-val capitalize_ascii : string -> string
-(** Return a copy of the argument, with the first character set to uppercase,
- using the US-ASCII character set.
- @since 4.03.0 *)
+val index_from : string -> int -> char -> int
+(** [index_from s i c] is the index of the first occurrence of [c] in
+ [s] after position [i].
-val uncapitalize_ascii : string -> string
-(** Return a copy of the argument, with the first character set to lowercase,
- using the US-ASCII character set.
- @since 4.03.0 *)
+ @raise Not_found if [c] does not occur in [s] after position [i].
+ @raise Invalid_argument if [i] is not a valid position in [s]. *)
-type t = string
-(** An alias for the type of strings. *)
-val compare: t -> t -> int
-(** The comparison function for strings, with the same specification as
- {!Stdlib.compare}. Along with the type [t], this function [compare]
- allows the module [String] to be passed as argument to the functors
- {!Set.Make} and {!Map.Make}. *)
+val index_from_opt : string -> int -> char -> int option
+(** [index_from_opt s i c] is the index of the first occurrence of [c]
+ in [s] after position [i] (if any).
+
+ @raise Invalid_argument if [i] is not a valid position in [s].
+ @since 4.05 *)
+
+val rindex_from : string -> int -> char -> int
+(** [rindex_from s i c] is the index of the last occurrence of [c] in
+ [s] before position [i+1].
-val equal: t -> t -> bool
-(** The equal function for strings.
- @since 4.03.0 *)
+ @raise Not_found if [c] does not occur in [s] before position [i+1].
+ @raise Invalid_argument if [i+1] is not a valid position in [s]. *)
-val split_on_char: char -> string -> string list
-(** [String.split_on_char sep s] returns the list of all (possibly empty)
- substrings of [s] that are delimited by the [sep] character.
+val rindex_from_opt : string -> int -> char -> int option
+(** [rindex_from_opt s i c] is the index of the last occurrence of [c]
+ in [s] before position [i+1] (if any).
- The function's output is specified by the following invariants:
+ @raise Invalid_argument if [i+1] is not a valid position in [s].
+ @since 4.05 *)
- - The list is not empty.
- - Concatenating its elements using [sep] as a separator returns a
- string equal to the input ([String.concat (String.make 1 sep)
- (String.split_on_char sep s) = s]).
- - No string in the result contains the [sep] character.
+val index : string -> char -> int
+(** [index s c] is {!String.index_from}[ s 0 c]. *)
- @since 4.04.0
-*)
+val index_opt : string -> char -> int option
+(** [index_opt s c] is {!String.index_from_opt}[ s 0 c].
+
+ @since 4.05 *)
+
+val rindex : string -> char -> int
+(** [rindex s c] is {!String.rindex_from}[ s (length s - 1) c]. *)
-(** {1 Iterators} *)
+val rindex_opt : string -> char -> int option
+(** [rindex_opt s c] is {!String.rindex_from_opt}[ s (length s - 1) c].
+
+ @since 4.05 *)
+
+(** {1:converting Converting} *)
val to_seq : t -> char Seq.t
-(** Iterate on the string, in increasing index order. Modifications of the
- string during iteration will be reflected in the iterator.
+(** [to_seq s] is a sequence made of the string's characters in
+ increasing order. In ["unsafe-string"] mode, modifications of the string
+ during iteration will be reflected in the iterator.
+
@since 4.07 *)
val to_seqi : t -> (int * char) Seq.t
-(** Iterate on the string, in increasing order, yielding indices along chars
+(** [to_seqi s] is like {!to_seq} but also tuples the corresponding index.
+
@since 4.07 *)
val of_seq : char Seq.t -> t
-(** Create a string from the generator
+(** [of_seq s] is a string made of the sequence's characters.
+
@since 4.07 *)
+(** {1:deprecated Deprecated functions} *)
+
+external create : int -> bytes = "caml_create_string"
+ [@@ocaml.deprecated "Use Bytes.create/BytesLabels.create instead."]
+(** [create n] returns a fresh byte sequence of length [n].
+ The sequence is uninitialized and contains arbitrary bytes.
+ @raise Invalid_argument if [n < 0] or [n > ]{!Sys.max_string_length}.
+
+ @deprecated This is a deprecated alias of
+ {!Bytes.create}/{!BytesLabels.create}. *)
+
+external set : bytes -> int -> char -> unit = "%string_safe_set"
+ [@@ocaml.deprecated "Use Bytes.set/BytesLabels.set instead."]
+(** [set s n c] modifies byte sequence [s] in place,
+ replacing the byte at index [n] with [c].
+ You can also write [s.[n] <- c] instead of [set s n c].
+ @raise Invalid_argument if [n] is not a valid index in [s].
+
+ @deprecated This is a deprecated alias of
+ {!Bytes.set}/{!BytesLabels.set}. *)
+
+val blit :
+ string -> int -> bytes -> int -> int -> unit
+(** [blit src src_pos dst dst_pos len] copies [len] bytes
+ from the string [src], starting at index [src_pos],
+ to byte sequence [dst], starting at character number [dst_pos].
+
+ @raise Invalid_argument if [src_pos] and [len] do not
+ designate a valid range of [src], or if [dst_pos] and [len]
+ do not designate a valid range of [dst]. *)
+
+val copy : string -> string
+ [@@ocaml.deprecated "Strings now immutable: no need to copy"]
+(** Return a copy of the given string.
+
+ @deprecated Because strings are immutable, it doesn't make much
+ sense to make identical copies of them. *)
+
+val fill : bytes -> int -> int -> char -> unit
+ [@@ocaml.deprecated "Use Bytes.fill/BytesLabels.fill instead."]
+(** [fill s pos len c] modifies byte sequence [s] in place,
+ replacing [len] bytes by [c], starting at [pos].
+ @raise Invalid_argument if [pos] and [len] do not
+ designate a valid substring of [s].
+
+ @deprecated This is a deprecated alias of
+ {!Bytes.fill}/{!BytesLabels.fill}. *)
+
+val uppercase : string -> string
+ [@@ocaml.deprecated
+ "Use String.uppercase_ascii/StringLabels.uppercase_ascii instead."]
+(** Return a copy of the argument, with all lowercase letters
+ translated to uppercase, including accented letters of the ISO
+ Latin-1 (8859-1) character set.
+
+ @deprecated Functions operating on Latin-1 character set are deprecated. *)
+
+val lowercase : string -> string
+ [@@ocaml.deprecated
+ "Use String.lowercase_ascii/StringLabels.lowercase_ascii instead."]
+(** Return a copy of the argument, with all uppercase letters
+ translated to lowercase, including accented letters of the ISO
+ Latin-1 (8859-1) character set.
+
+ @deprecated Functions operating on Latin-1 character set are deprecated. *)
+
+val capitalize : string -> string
+ [@@ocaml.deprecated
+ "Use String.capitalize_ascii/StringLabels.capitalize_ascii instead."]
+(** Return a copy of the argument, with the first character set to uppercase,
+ using the ISO Latin-1 (8859-1) character set..
+
+ @deprecated Functions operating on Latin-1 character set are deprecated. *)
+
+val uncapitalize : string -> string
+ [@@ocaml.deprecated
+ "Use String.uncapitalize_ascii/StringLabels.uncapitalize_ascii instead."]
+(** Return a copy of the argument, with the first character set to lowercase,
+ using the ISO Latin-1 (8859-1) character set.
+
+ @deprecated Functions operating on Latin-1 character set are deprecated. *)
+
(**/**)
(* The following is for system use only. Do not call directly. *)
external unsafe_set : bytes -> int -> char -> unit = "%string_unsafe_set"
[@@ocaml.deprecated]
external unsafe_blit :
- string -> int -> bytes -> int -> int -> unit
- = "caml_blit_string" [@@noalloc]
+ string -> int -> bytes -> int -> int ->
+ unit = "caml_blit_string" [@@noalloc]
external unsafe_fill :
bytes -> int -> int -> char -> unit = "caml_fill_string" [@@noalloc]
[@@ocaml.deprecated]
(* *)
(**************************************************************************)
-(** String operations.
- This module is intended to be used through {!StdLabels} which replaces
- {!Array}, {!Bytes}, {!List} and {!String} with their labeled counterparts
+(* NOTE:
+ If this file is stringLabels.mli, run tools/sync_stdlib_docs after editing
+ it to generate string.mli.
+
+ If this file is string.mli, do not edit it directly -- edit
+ stringLabels.mli instead.
+ *)
+
+(** Strings.
+
+ A string [s] of length [n] is an indexable and immutable sequence
+ of [n] bytes. For historical reasons these bytes are referred to
+ as characters.
+
+ The semantics of string functions is defined in terms of
+ indices and positions. These are depicted and described
+ as follows.
+
+{v
+positions 0 1 2 3 4 n-1 n
+ +---+---+---+---+ +-----+
+ indices | 0 | 1 | 2 | 3 | ... | n-1 |
+ +---+---+---+---+ +-----+
+v}
+ {ul
+ {- An {e index} [i] of [s] is an integer in the range \[[0];[n-1]\].
+ It represents the [i]th byte (character) of [s] which can be
+ accessed using the constant time string indexing operator
+ [s.[i]].}
+ {- A {e position} [i] of [s] is an integer in the range
+ \[[0];[n]\]. It represents either the point at the beginning of
+ the string, or the point between two indices, or the point at
+ the end of the string. The [i]th byte index is between position
+ [i] and [i+1].}}
+
+ Two integers [start] and [len] are said to define a {e valid
+ substring} of [s] if [len >= 0] and [start], [start+len] are
+ positions of [s].
+
+ {b Unicode text.} Strings being arbitrary sequences of bytes, they
+ can hold any kind of textual encoding. However the recommended
+ encoding for storing Unicode text in OCaml strings is UTF-8. This
+ is the encoding used by Unicode escapes in string literals. For
+ example the string ["\u{1F42B}"] is the UTF-8 encoding of the
+ Unicode character U+1F42B.
+
+ {b Past mutability.} OCaml strings used to be modifiable in place,
+ for instance via the {!String.set} and {!String.blit}
+ functions. This use is nowadays only possible when the compiler is
+ put in "unsafe-string" mode by giving the [-unsafe-string]
+ command-line option. This compatibility mode makes the types
+ [string] and [bytes] (see {!Bytes.t}) interchangeable so that
+ functions expecting byte sequences can also accept strings as
+ arguments and modify them.
+
+ The distinction between [bytes] and [string] was introduced in
+ OCaml 4.02, and the "unsafe-string" compatibility mode was the
+ default until OCaml 4.05. Starting with 4.06, the compatibility
+ mode is opt-in; we intend to remove the option in the future.
+
+ The labeled version of this module can be used as described in the
+ {!StdLabels} module.
+*)
+
+(** {1:strings Strings} *)
+
+type t = string
+(** The type for strings. *)
- For example:
- {[
- open StdLabels
+val make : int -> char -> string
+(** [make n c] is a string of length [n] with each index holding the
+ character [c].
+
+ @raise Invalid_argument if [n < 0] or [n > ]{!Sys.max_string_length}. *)
- let to_upper = String.map ~f:Char.uppercase_ascii
- ]} *)
+val init : int -> f:(int -> char) -> string
+(** [init n ~f] is a string of length [n] with index
+ [i] holding the character [f i] (called in increasing index order).
+
+ @raise Invalid_argument if [n < 0] or [n > ]{!Sys.max_string_length}.
+ @since 4.02.0 *)
external length : string -> int = "%string_length"
-(** Return the length (number of characters) of the given string. *)
+(** [length s] is the length (number of bytes/characters) of [s]. *)
external get : string -> int -> char = "%string_safe_get"
-(** [String.get s n] returns the character at index [n] in string [s].
- You can also write [s.[n]] instead of [String.get s n].
- @raise Invalid_argument if [n] not a valid index in [s]. *)
+(** [get s i] is the character at index [i] in [s]. This is the same
+ as writing [s.[i]].
-external set : bytes -> int -> char -> unit = "%string_safe_set"
- [@@ocaml.deprecated "Use BytesLabels.set instead."]
-(** [String.set s n c] modifies byte sequence [s] in place,
- replacing the byte at index [n] with [c].
- You can also write [s.[n] <- c] instead of [String.set s n c].
- @raise Invalid_argument if [n] is not a valid index in [s].
+ @raise Invalid_argument if [i] not an index of [s]. *)
- @deprecated This is a deprecated alias of {!BytesLabels.set}. *)
+(** {1:concat Concatenating}
-external create : int -> bytes = "caml_create_string"
- [@@ocaml.deprecated "Use BytesLabels.create instead."]
-(** [String.create n] returns a fresh byte sequence of length [n].
- The sequence is uninitialized and contains arbitrary bytes.
- @raise Invalid_argument if [n < 0] or [n > ]{!Sys.max_string_length}.
+ {b Note.} The {!Stdlib.( ^ )} binary operator concatenates two
+ strings. *)
- @deprecated This is a deprecated alias of {!BytesLabels.create}. *)
+val concat : sep:string -> string list -> string
+(** [concat ~sep ss] concatenates the list of strings [ss], inserting
+ the separator string [sep] between each.
-val make : int -> char -> string
-(** [String.make n c] returns a fresh string of length [n],
- filled with the character [c].
- @raise Invalid_argument if [n < 0] or [n > ]{!Sys.max_string_length}. *)
+ @raise Invalid_argument if the result is longer than
+ {!Sys.max_string_length} bytes. *)
-val init : int -> f:(int -> char) -> string
-(** [init n f] returns a string of length [n],
- with character [i] initialized to the result of [f i].
- @raise Invalid_argument if [n < 0] or [n > ]{!Sys.max_string_length}.
- @since 4.02.0 *)
+(** {1:predicates Predicates and comparisons} *)
-val copy : string -> string [@@ocaml.deprecated]
-(** Return a copy of the given string. *)
+val equal : t -> t -> bool
+(** [equal s0 s1] is [true] if and only if [s0] and [s1] are character-wise
+ equal.
+ @since 4.03.0 (4.05.0 in StringLabels) *)
-val sub : string -> pos:int -> len:int -> string
-(** [String.sub s start len] returns a fresh string of length [len],
- containing the substring of [s] that starts at position [start] and
- has length [len].
- @raise Invalid_argument if [start] and [len] do not
- designate a valid substring of [s]. *)
+val compare : t -> t -> int
+(** [compare s0 s1] sorts [s0] and [s1] in lexicographical order. [compare]
+ behaves like {!Stdlib.compare} on strings but may be more efficient. *)
-val fill : bytes -> pos:int -> len:int -> char -> unit
- [@@ocaml.deprecated "Use BytesLabels.fill instead."]
-(** [String.fill s start len c] modifies byte sequence [s] in place,
- replacing [len] bytes by [c], starting at [start].
- @raise Invalid_argument if [start] and [len] do not
- designate a valid substring of [s].
+val contains_from : string -> int -> char -> bool
+(** [contains_from s start c] is [true] if and only if [c] appears in [s]
+ after position [start].
- @deprecated This is a deprecated alias of {!BytesLabels.fill}. *)
+ @raise Invalid_argument if [start] is not a valid position in [s]. *)
-val blit :
- src:string -> src_pos:int -> dst:bytes -> dst_pos:int -> len:int
- -> unit
-(** [String.blit src srcoff dst dstoff len] copies [len] bytes
- from the string [src], starting at index [srcoff],
- to byte sequence [dst], starting at character number [dstoff].
- @raise Invalid_argument if [srcoff] and [len] do not
- designate a valid range of [src], or if [dstoff] and [len]
- do not designate a valid range of [dst]. *)
+val rcontains_from : string -> int -> char -> bool
+(** [rcontains_from s stop c] is [true] if and only if [c] appears in [s]
+ before position [stop+1].
-val concat : sep:string -> string list -> string
-(** [String.concat sep sl] concatenates the list of strings [sl],
- inserting the separator string [sep] between each. *)
+ @raise Invalid_argument if [stop < 0] or [stop+1] is not a valid
+ position in [s]. *)
-val iter : f:(char -> unit) -> string -> unit
-(** [String.iter f s] applies function [f] in turn to all
- the characters of [s]. It is equivalent to
- [f s.[0]; f s.[1]; ...; f s.[String.length s - 1]; ()]. *)
+val contains : string -> char -> bool
+(** [contains s c] is {!String.contains_from}[ s 0 c]. *)
-val iteri : f:(int -> char -> unit) -> string -> unit
-(** Same as {!String.iter}, but the
- function is applied to the index of the element as first argument
- (counting from 0), and the character itself as second argument.
- @since 4.00.0 *)
+(** {1:extract Extracting substrings} *)
+
+val sub : string -> pos:int -> len:int -> string
+(** [sub s ~pos ~len] is a string of length [len], containing the
+ substring of [s] that starts at position [pos] and has length
+ [len].
+
+ @raise Invalid_argument if [pos] and [len] do not designate a valid
+ substring of [s]. *)
+
+val split_on_char : sep:char -> string -> string list
+(** [split_on_char ~sep s] is the list of all (possibly empty)
+ substrings of [s] that are delimited by the character [sep].
+
+ The function's result is specified by the following invariants:
+ {ul
+ {- The list is not empty.}
+ {- Concatenating its elements using [sep] as a separator returns a
+ string equal to the input ([concat (make 1 sep)
+ (split_on_char sep s) = s]).}
+ {- No string in the result contains the [sep] character.}}
+
+ @since 4.04.0 (4.05.0 in StringLabels) *)
+
+(** {1:transforming Transforming} *)
val map : f:(char -> char) -> string -> string
-(** [String.map f s] applies function [f] in turn to all
- the characters of [s] and stores the results in a new string that
- is returned.
- @since 4.00.0 *)
+(** [map f s] is the string resulting from applying [f] to all the
+ characters of [s] in increasing order.
+
+ @since 4.00.0 *)
val mapi : f:(int -> char -> char) -> string -> string
-(** [String.mapi f s] calls [f] with each character of [s] and its
- index (in increasing index order) and stores the results in a new
- string that is returned.
+(** [mapi ~f s] is like {!map} but the index of the character is also
+ passed to [f].
+
@since 4.02.0 *)
val trim : string -> string
-(** Return a copy of the argument, without leading and trailing
- whitespace. The characters regarded as whitespace are: [' '],
- ['\012'], ['\n'], ['\r'], and ['\t']. If there is no leading nor
- trailing whitespace character in the argument, return the original
- string itself, not a copy.
- @since 4.00.0 *)
+(** [trim s] is [s] without leading and trailing whitespace. Whitespace
+ characters are: [' '], ['\x0C'] (form feed), ['\n'], ['\r'], and ['\t'].
+
+ @since 4.00.0 *)
val escaped : string -> string
-(** Return a copy of the argument, with special characters
- represented by escape sequences, following the lexical
- conventions of OCaml. If there is no special
- character in the argument, return the original string itself,
- not a copy. Its inverse function is Scanf.unescaped. *)
+(** [escaped s] is [s] with special characters represented by escape
+ sequences, following the lexical conventions of OCaml.
-val index : string -> char -> int
-(** [String.index s c] returns the index of the first
- occurrence of character [c] in string [s].
- @raise Not_found if [c] does not occur in [s]. *)
-
-val index_opt: string -> char -> int option
-(** [String.index_opt s c] returns the index of the first
- occurrence of character [c] in string [s], or
- [None] if [c] does not occur in [s].
- @since 4.05 *)
+ All characters outside the US-ASCII printable range \[0x20;0x7E\] are
+ escaped, as well as backslash (0x2F) and double-quote (0x22).
-val rindex : string -> char -> int
-(** [String.rindex s c] returns the index of the last
- occurrence of character [c] in string [s].
- @raise Not_found if [c] does not occur in [s]. *)
-
-val rindex_opt: string -> char -> int option
-(** [String.rindex_opt s c] returns the index of the last occurrence
- of character [c] in string [s], or [None] if [c] does not occur in
- [s].
- @since 4.05 *)
+ The function {!Scanf.unescaped} is a left inverse of [escaped],
+ i.e. [Scanf.unescaped (escaped s) = s] for any string [s] (unless
+ [escaped s] fails).
-val index_from : string -> int -> char -> int
-(** [String.index_from s i c] returns the index of the
- first occurrence of character [c] in string [s] after position [i].
- [String.index s c] is equivalent to [String.index_from s 0 c].
- @raise Invalid_argument if [i] is not a valid position in [s].
- @raise Not_found if [c] does not occur in [s] after position [i]. *)
-
-val index_from_opt: string -> int -> char -> int option
-(** [String.index_from_opt s i c] returns the index of the
- first occurrence of character [c] in string [s] after position [i]
- or [None] if [c] does not occur in [s] after position [i].
-
- [String.index_opt s c] is equivalent to [String.index_from_opt s 0 c].
- @raise Invalid_argument if [i] is not a valid position in [s].
+ @raise Invalid_argument if the result is longer than
+ {!Sys.max_string_length} bytes. *)
- @since 4.05
-*)
+val uppercase_ascii : string -> string
+(** [uppercase_ascii s] is [s] with all lowercase letters
+ translated to uppercase, using the US-ASCII character set.
-val rindex_from : string -> int -> char -> int
-(** [String.rindex_from s i c] returns the index of the
- last occurrence of character [c] in string [s] before position [i+1].
- [String.rindex s c] is equivalent to
- [String.rindex_from s (String.length s - 1) c].
- @raise Invalid_argument if [i+1] is not a valid position in [s].
- @raise Not_found if [c] does not occur in [s] before position [i+1]. *)
-
-val rindex_from_opt: string -> int -> char -> int option
-(** [String.rindex_from_opt s i c] returns the index of the
- last occurrence of character [c] in string [s] before position [i+1]
- or [None] if [c] does not occur in [s] before position [i+1].
-
- [String.rindex_opt s c] is equivalent to
- [String.rindex_from_opt s (String.length s - 1) c].
- @raise Invalid_argument if [i+1] is not a valid position in [s].
-
- @since 4.05
-*)
+ @since 4.03.0 (4.05.0 in StringLabels) *)
-val contains : string -> char -> bool
-(** [String.contains s c] tests if character [c]
- appears in the string [s]. *)
+val lowercase_ascii : string -> string
+(** [lowercase_ascii s] is [s] with all uppercase letters translated
+ to lowercase, using the US-ASCII character set.
-val contains_from : string -> int -> char -> bool
-(** [String.contains_from s start c] tests if character [c]
- appears in [s] after position [start].
- [String.contains s c] is equivalent to
- [String.contains_from s 0 c].
- @raise Invalid_argument if [start] is not a valid position in [s]. *)
+ @since 4.03.0 (4.05.0 in StringLabels) *)
-val rcontains_from : string -> int -> char -> bool
-(** [String.rcontains_from s stop c] tests if character [c]
- appears in [s] before position [stop+1].
- @raise Invalid_argument if [stop < 0] or [stop+1] is not a valid
- position in [s]. *)
+val capitalize_ascii : string -> string
+(** [capitalize_ascii s] is [s] with the first character set to
+ uppercase, using the US-ASCII character set.
-val uppercase : string -> string
- [@@ocaml.deprecated "Use String.uppercase_ascii instead."]
-(** Return a copy of the argument, with all lowercase letters
- translated to uppercase, including accented letters of the ISO
- Latin-1 (8859-1) character set.
- @deprecated Functions operating on Latin-1 character set are deprecated. *)
+ @since 4.03.0 (4.05.0 in StringLabels) *)
-val lowercase : string -> string
- [@@ocaml.deprecated "Use String.lowercase_ascii instead."]
-(** Return a copy of the argument, with all uppercase letters
- translated to lowercase, including accented letters of the ISO
- Latin-1 (8859-1) character set.
- @deprecated Functions operating on Latin-1 character set are deprecated. *)
+val uncapitalize_ascii : string -> string
+(** [uncapitalize_ascii s] is [s] with the first character set to lowercase,
+ using the US-ASCII character set.
-val capitalize : string -> string
- [@@ocaml.deprecated "Use String.capitalize_ascii instead."]
-(** Return a copy of the argument, with the first character set to uppercase,
- using the ISO Latin-1 (8859-1) character set..
- @deprecated Functions operating on Latin-1 character set are deprecated. *)
+ @since 4.03.0 (4.05.0 in StringLabels) *)
-val uncapitalize : string -> string
- [@@ocaml.deprecated "Use String.uncapitalize_ascii instead."]
-(** Return a copy of the argument, with the first character set to lowercase,
- using the ISO Latin-1 (8859-1) character set..
- @deprecated Functions operating on Latin-1 character set are deprecated. *)
+(** {1:traversing Traversing} *)
-val uppercase_ascii : string -> string
-(** Return a copy of the argument, with all lowercase letters
- translated to uppercase, using the US-ASCII character set.
- @since 4.05.0 *)
+val iter : f:(char -> unit) -> string -> unit
+(** [iter ~f s] applies function [f] in turn to all the characters of [s].
+ It is equivalent to [f s.[0]; f s.[1]; ...; f s.[length s - 1]; ()]. *)
-val lowercase_ascii : string -> string
-(** Return a copy of the argument, with all uppercase letters
- translated to lowercase, using the US-ASCII character set.
- @since 4.05.0 *)
+val iteri : f:(int -> char -> unit) -> string -> unit
+(** [iteri] is like {!iter}, but the function is also given the
+ corresponding character index.
-val capitalize_ascii : string -> string
-(** Return a copy of the argument, with the first character set to uppercase,
- using the US-ASCII character set.
- @since 4.05.0 *)
+ @since 4.00.0 *)
-val uncapitalize_ascii : string -> string
-(** Return a copy of the argument, with the first character set to lowercase,
- using the US-ASCII character set.
- @since 4.05.0 *)
+(** {1:searching Searching} *)
-type t = string
-(** An alias for the type of strings. *)
+val index_from : string -> int -> char -> int
+(** [index_from s i c] is the index of the first occurrence of [c] in
+ [s] after position [i].
-val compare: t -> t -> int
-(** The comparison function for strings, with the same specification as
- {!Stdlib.compare}. Along with the type [t], this function [compare]
- allows the module [String] to be passed as argument to the functors
- {!Set.Make} and {!Map.Make}. *)
+ @raise Not_found if [c] does not occur in [s] after position [i].
+ @raise Invalid_argument if [i] is not a valid position in [s]. *)
-val equal: t -> t -> bool
-(** The equal function for strings.
- @since 4.05.0 *)
-val split_on_char: sep:char -> string -> string list
-(** [String.split_on_char sep s] returns the list of all (possibly empty)
- substrings of [s] that are delimited by the [sep] character.
+val index_from_opt : string -> int -> char -> int option
+(** [index_from_opt s i c] is the index of the first occurrence of [c]
+ in [s] after position [i] (if any).
- The function's output is specified by the following invariants:
+ @raise Invalid_argument if [i] is not a valid position in [s].
+ @since 4.05 *)
- - The list is not empty.
- - Concatenating its elements using [sep] as a separator returns a
- string equal to the input ([String.concat (String.make 1 sep)
- (String.split_on_char sep s) = s]).
- - No string in the result contains the [sep] character.
+val rindex_from : string -> int -> char -> int
+(** [rindex_from s i c] is the index of the last occurrence of [c] in
+ [s] before position [i+1].
- @since 4.05.0
-*)
+ @raise Not_found if [c] does not occur in [s] before position [i+1].
+ @raise Invalid_argument if [i+1] is not a valid position in [s]. *)
+
+val rindex_from_opt : string -> int -> char -> int option
+(** [rindex_from_opt s i c] is the index of the last occurrence of [c]
+ in [s] before position [i+1] (if any).
+
+ @raise Invalid_argument if [i+1] is not a valid position in [s].
+ @since 4.05 *)
+
+val index : string -> char -> int
+(** [index s c] is {!String.index_from}[ s 0 c]. *)
+
+val index_opt : string -> char -> int option
+(** [index_opt s c] is {!String.index_from_opt}[ s 0 c].
+
+ @since 4.05 *)
+
+val rindex : string -> char -> int
+(** [rindex s c] is {!String.rindex_from}[ s (length s - 1) c]. *)
-(** {1 Iterators} *)
+val rindex_opt : string -> char -> int option
+(** [rindex_opt s c] is {!String.rindex_from_opt}[ s (length s - 1) c].
+
+ @since 4.05 *)
+
+(** {1:converting Converting} *)
val to_seq : t -> char Seq.t
-(** Iterate on the string, in increasing index order. Modifications of the
- string during iteration will be reflected in the iterator.
+(** [to_seq s] is a sequence made of the string's characters in
+ increasing order. In ["unsafe-string"] mode, modifications of the string
+ during iteration will be reflected in the iterator.
+
@since 4.07 *)
val to_seqi : t -> (int * char) Seq.t
-(** Iterate on the string, in increasing order, yielding indices along chars
+(** [to_seqi s] is like {!to_seq} but also tuples the corresponding index.
+
@since 4.07 *)
val of_seq : char Seq.t -> t
-(** Create a string from the generator
+(** [of_seq s] is a string made of the sequence's characters.
+
@since 4.07 *)
+(** {1:deprecated Deprecated functions} *)
+
+external create : int -> bytes = "caml_create_string"
+ [@@ocaml.deprecated "Use Bytes.create/BytesLabels.create instead."]
+(** [create n] returns a fresh byte sequence of length [n].
+ The sequence is uninitialized and contains arbitrary bytes.
+ @raise Invalid_argument if [n < 0] or [n > ]{!Sys.max_string_length}.
+
+ @deprecated This is a deprecated alias of
+ {!Bytes.create}/{!BytesLabels.create}. *)
+
+external set : bytes -> int -> char -> unit = "%string_safe_set"
+ [@@ocaml.deprecated "Use Bytes.set/BytesLabels.set instead."]
+(** [set s n c] modifies byte sequence [s] in place,
+ replacing the byte at index [n] with [c].
+ You can also write [s.[n] <- c] instead of [set s n c].
+ @raise Invalid_argument if [n] is not a valid index in [s].
+
+ @deprecated This is a deprecated alias of
+ {!Bytes.set}/{!BytesLabels.set}. *)
+
+val blit :
+ src:string -> src_pos:int -> dst:bytes -> dst_pos:int -> len:int -> unit
+(** [blit ~src ~src_pos ~dst ~dst_pos ~len] copies [len] bytes
+ from the string [src], starting at index [src_pos],
+ to byte sequence [dst], starting at character number [dst_pos].
+
+ @raise Invalid_argument if [src_pos] and [len] do not
+ designate a valid range of [src], or if [dst_pos] and [len]
+ do not designate a valid range of [dst]. *)
+
+val copy : string -> string
+ [@@ocaml.deprecated "Strings now immutable: no need to copy"]
+(** Return a copy of the given string.
+
+ @deprecated Because strings are immutable, it doesn't make much
+ sense to make identical copies of them. *)
+
+val fill : bytes -> pos:int -> len:int -> char -> unit
+ [@@ocaml.deprecated "Use Bytes.fill/BytesLabels.fill instead."]
+(** [fill s ~pos ~len c] modifies byte sequence [s] in place,
+ replacing [len] bytes by [c], starting at [pos].
+ @raise Invalid_argument if [pos] and [len] do not
+ designate a valid substring of [s].
+
+ @deprecated This is a deprecated alias of
+ {!Bytes.fill}/{!BytesLabels.fill}. *)
+
+val uppercase : string -> string
+ [@@ocaml.deprecated
+ "Use String.uppercase_ascii/StringLabels.uppercase_ascii instead."]
+(** Return a copy of the argument, with all lowercase letters
+ translated to uppercase, including accented letters of the ISO
+ Latin-1 (8859-1) character set.
+
+ @deprecated Functions operating on Latin-1 character set are deprecated. *)
+
+val lowercase : string -> string
+ [@@ocaml.deprecated
+ "Use String.lowercase_ascii/StringLabels.lowercase_ascii instead."]
+(** Return a copy of the argument, with all uppercase letters
+ translated to lowercase, including accented letters of the ISO
+ Latin-1 (8859-1) character set.
+
+ @deprecated Functions operating on Latin-1 character set are deprecated. *)
+
+val capitalize : string -> string
+ [@@ocaml.deprecated
+ "Use String.capitalize_ascii/StringLabels.capitalize_ascii instead."]
+(** Return a copy of the argument, with the first character set to uppercase,
+ using the ISO Latin-1 (8859-1) character set..
+
+ @deprecated Functions operating on Latin-1 character set are deprecated. *)
+
+val uncapitalize : string -> string
+ [@@ocaml.deprecated
+ "Use String.uncapitalize_ascii/StringLabels.uncapitalize_ascii instead."]
+(** Return a copy of the argument, with the first character set to lowercase,
+ using the ISO Latin-1 (8859-1) character set.
+
+ @deprecated Functions operating on Latin-1 character set are deprecated. *)
+
(**/**)
(* The following is for system use only. Do not call directly. *)
external chdir : string -> unit = "caml_sys_chdir"
(** Change the current working directory of the process. *)
+external mkdir : string -> int -> unit = "caml_sys_mkdir"
+(** Create a directory with the given permissions.
+
+ @since 4.12.0
+*)
+
+external rmdir : string -> unit = "caml_sys_rmdir"
+(** Remove an empty directory.
+
+ @since 4.12.0
+*)
+
external getcwd : unit -> string = "caml_sys_getcwd"
(** Return the current working directory of the process. *)
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"
--- /dev/null
+These templates are fragments of OCaml source files, which
+tools/sync_stdlib_docs uses to build the full labeled and unlabeled stdlib
+modules. At present, tools/sync_stdlib_docs must be run manually -- it is not a
+build task.
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* Nicolas Ojeda Bar, LexiFi *)
+(* *)
+(* Copyright 2018 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(* NOTE:
+ If this file is float.template.mli, run tools/sync_stdlib_docs after editing
+ it to generate float.mli.
+
+ If this file is float.mli, do not edit it directly -- edit
+ templates/float.template.mli instead.
+ *)
+
+(** Floating-point arithmetic.
+
+ OCaml's floating-point numbers follow the
+ IEEE 754 standard, using double precision (64 bits) numbers.
+ Floating-point operations never raise an exception on overflow,
+ underflow, division by zero, etc. Instead, special IEEE numbers
+ are returned as appropriate, such as [infinity] for [1.0 /. 0.0],
+ [neg_infinity] for [-1.0 /. 0.0], and [nan] ('not a number')
+ for [0.0 /. 0.0]. These special numbers then propagate through
+ floating-point computations as expected: for instance,
+ [1.0 /. infinity] is [0.0], basic arithmetic operations
+ ([+.], [-.], [*.], [/.]) with [nan] as an argument return [nan], ...
+
+ @since 4.07.0
+*)
+
+val zero : float
+(** The floating point 0.
+ @since 4.08.0 *)
+
+val one : float
+(** The floating-point 1.
+ @since 4.08.0 *)
+
+val minus_one : float
+(** The floating-point -1.
+ @since 4.08.0 *)
+
+external neg : float -> float = "%negfloat"
+(** Unary negation. *)
+
+external add : float -> float -> float = "%addfloat"
+(** Floating-point addition. *)
+
+external sub : float -> float -> float = "%subfloat"
+(** Floating-point subtraction. *)
+
+external mul : float -> float -> float = "%mulfloat"
+(** Floating-point multiplication. *)
+
+external div : float -> float -> float = "%divfloat"
+(** Floating-point division. *)
+
+external fma : float -> float -> float -> float =
+ "caml_fma_float" "caml_fma" [@@unboxed] [@@noalloc]
+(** [fma x y z] returns [x * y + z], with a best effort for computing
+ this expression with a single rounding, using either hardware
+ instructions (providing full IEEE compliance) or a software
+ emulation. Note: since software emulation of the fma is costly,
+ make sure that you are using hardware fma support if performance
+ matters. @since 4.08.0 *)
+
+external rem : float -> float -> float = "caml_fmod_float" "fmod"
+[@@unboxed] [@@noalloc]
+(** [rem a b] returns the remainder of [a] with respect to [b]. The returned
+ value is [a -. n *. b], where [n] is the quotient [a /. b] rounded towards
+ zero to an integer. *)
+
+val succ : float -> float
+(** [succ x] returns the floating point number right after [x] i.e.,
+ the smallest floating-point number greater than [x]. See also
+ {!next_after}.
+ @since 4.08.0 *)
+
+val pred : float -> float
+(** [pred x] returns the floating-point number right before [x] i.e.,
+ the greatest floating-point number smaller than [x]. See also
+ {!next_after}.
+ @since 4.08.0 *)
+
+external abs : float -> float = "%absfloat"
+(** [abs f] returns the absolute value of [f]. *)
+
+val infinity : float
+(** Positive infinity. *)
+
+val neg_infinity : float
+(** Negative infinity. *)
+
+val nan : float
+(** A special floating-point value denoting the result of an
+ undefined operation such as [0.0 /. 0.0]. Stands for
+ 'not a number'. Any floating-point operation with [nan] as
+ argument returns [nan] as result. As for floating-point comparisons,
+ [=], [<], [<=], [>] and [>=] return [false] and [<>] returns [true]
+ if one or both of their arguments is [nan]. *)
+
+val pi : float
+(** The constant pi. *)
+
+val max_float : float
+(** The largest positive finite value of type [float]. *)
+
+val min_float : float
+(** The smallest positive, non-zero, non-denormalized value of type [float]. *)
+
+val epsilon : float
+(** The difference between [1.0] and the smallest exactly representable
+ floating-point number greater than [1.0]. *)
+
+val is_finite : float -> bool
+(** [is_finite x] is [true] if and only if [x] is finite i.e., not infinite and
+ not {!nan}.
+
+ @since 4.08.0 *)
+
+val is_infinite : float -> bool
+(** [is_infinite x] is [true] if and only if [x] is {!infinity} or
+ {!neg_infinity}.
+
+ @since 4.08.0 *)
+
+val is_nan : float -> bool
+(** [is_nan x] is [true] if and only if [x] is not a number (see {!nan}).
+
+ @since 4.08.0 *)
+
+val is_integer : float -> bool
+(** [is_integer x] is [true] if and only if [x] is an integer.
+
+ @since 4.08.0 *)
+
+external of_int : int -> float = "%floatofint"
+(** Convert an integer to floating-point. *)
+
+external to_int : float -> int = "%intoffloat"
+(** Truncate the given floating-point number to an integer.
+ The result is unspecified if the argument is [nan] or falls outside the
+ range of representable integers. *)
+
+external of_string : string -> float = "caml_float_of_string"
+(** Convert the given string to a float. The string is read in decimal
+ (by default) or in hexadecimal (marked by [0x] or [0X]).
+ The format of decimal floating-point numbers is
+ [ [-] dd.ddd (e|E) [+|-] dd ], where [d] stands for a decimal digit.
+ The format of hexadecimal floating-point numbers is
+ [ [-] 0(x|X) hh.hhh (p|P) [+|-] dd ], where [h] stands for an
+ hexadecimal digit and [d] for a decimal digit.
+ In both cases, at least one of the integer and fractional parts must be
+ given; the exponent part is optional.
+ The [_] (underscore) character can appear anywhere in the string
+ and is ignored.
+ Depending on the execution platforms, other representations of
+ floating-point numbers can be accepted, but should not be relied upon.
+ @raise Failure if the given string is not a valid
+ representation of a float. *)
+
+val of_string_opt: string -> float option
+(** Same as [of_string], but returns [None] instead of raising. *)
+
+val to_string : float -> string
+(** Return the string representation of a floating-point number. *)
+
+type fpclass = Stdlib.fpclass =
+ FP_normal (** Normal number, none of the below *)
+ | FP_subnormal (** Number very close to 0.0, has reduced precision *)
+ | FP_zero (** Number is 0.0 or -0.0 *)
+ | FP_infinite (** Number is positive or negative infinity *)
+ | FP_nan (** Not a number: result of an undefined operation *)
+(** The five classes of floating-point numbers, as determined by
+ the {!classify_float} function. *)
+
+external classify_float : (float [@unboxed]) -> fpclass =
+ "caml_classify_float" "caml_classify_float_unboxed" [@@noalloc]
+(** Return the class of the given floating-point number:
+ normal, subnormal, zero, infinite, or not a number. *)
+
+external pow : float -> float -> float = "caml_power_float" "pow"
+[@@unboxed] [@@noalloc]
+(** Exponentiation. *)
+
+external sqrt : float -> float = "caml_sqrt_float" "sqrt"
+[@@unboxed] [@@noalloc]
+(** Square root. *)
+
+external exp : float -> float = "caml_exp_float" "exp" [@@unboxed] [@@noalloc]
+(** Exponential. *)
+
+external log : float -> float = "caml_log_float" "log" [@@unboxed] [@@noalloc]
+(** Natural logarithm. *)
+
+external log10 : float -> float = "caml_log10_float" "log10"
+[@@unboxed] [@@noalloc]
+(** Base 10 logarithm. *)
+
+external expm1 : float -> float = "caml_expm1_float" "caml_expm1"
+[@@unboxed] [@@noalloc]
+(** [expm1 x] computes [exp x -. 1.0], giving numerically-accurate results
+ even if [x] is close to [0.0]. *)
+
+external log1p : float -> float = "caml_log1p_float" "caml_log1p"
+[@@unboxed] [@@noalloc]
+(** [log1p x] computes [log(1.0 +. x)] (natural logarithm),
+ giving numerically-accurate results even if [x] is close to [0.0]. *)
+
+external cos : float -> float = "caml_cos_float" "cos" [@@unboxed] [@@noalloc]
+(** Cosine. Argument is in radians. *)
+
+external sin : float -> float = "caml_sin_float" "sin" [@@unboxed] [@@noalloc]
+(** Sine. Argument is in radians. *)
+
+external tan : float -> float = "caml_tan_float" "tan" [@@unboxed] [@@noalloc]
+(** Tangent. Argument is in radians. *)
+
+external acos : float -> float = "caml_acos_float" "acos"
+[@@unboxed] [@@noalloc]
+(** Arc cosine. The argument must fall within the range [[-1.0, 1.0]].
+ Result is in radians and is between [0.0] and [pi]. *)
+
+external asin : float -> float = "caml_asin_float" "asin"
+[@@unboxed] [@@noalloc]
+(** Arc sine. The argument must fall within the range [[-1.0, 1.0]].
+ Result is in radians and is between [-pi/2] and [pi/2]. *)
+
+external atan : float -> float = "caml_atan_float" "atan"
+[@@unboxed] [@@noalloc]
+(** Arc tangent.
+ Result is in radians and is between [-pi/2] and [pi/2]. *)
+
+external atan2 : float -> float -> float = "caml_atan2_float" "atan2"
+[@@unboxed] [@@noalloc]
+(** [atan2 y x] returns the arc tangent of [y /. x]. The signs of [x]
+ and [y] are used to determine the quadrant of the result.
+ Result is in radians and is between [-pi] and [pi]. *)
+
+external hypot : float -> float -> float = "caml_hypot_float" "caml_hypot"
+[@@unboxed] [@@noalloc]
+(** [hypot x y] returns [sqrt(x *. x + y *. y)], that is, the length
+ of the hypotenuse of a right-angled triangle with sides of length
+ [x] and [y], or, equivalently, the distance of the point [(x,y)]
+ to origin. If one of [x] or [y] is infinite, returns [infinity]
+ even if the other is [nan]. *)
+
+external cosh : float -> float = "caml_cosh_float" "cosh"
+[@@unboxed] [@@noalloc]
+(** Hyperbolic cosine. Argument is in radians. *)
+
+external sinh : float -> float = "caml_sinh_float" "sinh"
+[@@unboxed] [@@noalloc]
+(** Hyperbolic sine. Argument is in radians. *)
+
+external tanh : float -> float = "caml_tanh_float" "tanh"
+[@@unboxed] [@@noalloc]
+(** Hyperbolic tangent. Argument is in radians. *)
+
+external trunc : float -> float = "caml_trunc_float" "caml_trunc"
+ [@@unboxed] [@@noalloc]
+(** [trunc x] rounds [x] to the nearest integer whose absolute value is
+ less than or equal to [x].
+
+ @since 4.08.0 *)
+
+external round : float -> float = "caml_round_float" "caml_round"
+ [@@unboxed] [@@noalloc]
+(** [round x] rounds [x] to the nearest integer with ties (fractional
+ values of 0.5) rounded away from zero, regardless of the current
+ rounding direction. If [x] is an integer, [+0.], [-0.], [nan], or
+ infinite, [x] itself is returned.
+
+ @since 4.08.0 *)
+
+external ceil : float -> float = "caml_ceil_float" "ceil"
+[@@unboxed] [@@noalloc]
+(** Round above to an integer value.
+ [ceil f] returns the least integer value greater than or equal to [f].
+ The result is returned as a float. *)
+
+external floor : float -> float = "caml_floor_float" "floor"
+[@@unboxed] [@@noalloc]
+(** Round below to an integer value.
+ [floor f] returns the greatest integer value less than or
+ equal to [f].
+ The result is returned as a float. *)
+
+external next_after : float -> float -> float
+ = "caml_nextafter_float" "caml_nextafter" [@@unboxed] [@@noalloc]
+(** [next_after x y] returns the next representable floating-point
+ value following [x] in the direction of [y]. More precisely, if
+ [y] is greater (resp. less) than [x], it returns the smallest
+ (resp. largest) representable number greater (resp. less) than [x].
+ If [x] equals [y], the function returns [y]. If [x] or [y] is
+ [nan], a [nan] is returned.
+ Note that [next_after max_float infinity = infinity] and that
+ [next_after 0. infinity] is the smallest denormalized positive number.
+ If [x] is the smallest denormalized positive number,
+ [next_after x 0. = 0.]
+
+ @since 4.08.0 *)
+
+external copy_sign : float -> float -> float
+ = "caml_copysign_float" "caml_copysign"
+[@@unboxed] [@@noalloc]
+(** [copy_sign x y] returns a float whose absolute value is that of [x]
+ and whose sign is that of [y]. If [x] is [nan], returns [nan].
+ If [y] is [nan], returns either [x] or [-. x], but it is not
+ specified which. *)
+
+external sign_bit : (float [@unboxed]) -> bool
+ = "caml_signbit_float" "caml_signbit" [@@noalloc]
+(** [sign_bit x] is [true] if and only if the sign bit of [x] is set.
+ For example [sign_bit 1.] and [signbit 0.] are [false] while
+ [sign_bit (-1.)] and [sign_bit (-0.)] are [true].
+
+ @since 4.08.0 *)
+
+external frexp : float -> float * int = "caml_frexp_float"
+(** [frexp f] returns the pair of the significant
+ and the exponent of [f]. When [f] is zero, the
+ significant [x] and the exponent [n] of [f] are equal to
+ zero. When [f] is non-zero, they are defined by
+ [f = x *. 2 ** n] and [0.5 <= x < 1.0]. *)
+
+external ldexp : (float [@unboxed]) -> (int [@untagged]) -> (float [@unboxed]) =
+ "caml_ldexp_float" "caml_ldexp_float_unboxed" [@@noalloc]
+(** [ldexp x n] returns [x *. 2 ** n]. *)
+
+external modf : float -> float * float = "caml_modf_float"
+(** [modf f] returns the pair of the fractional and integral
+ part of [f]. *)
+
+type t = float
+(** An alias for the type of floating-point numbers. *)
+
+val compare: t -> t -> int
+(** [compare x y] returns [0] if [x] is equal to [y], a negative integer if [x]
+ is less than [y], and a positive integer if [x] is greater than
+ [y]. [compare] treats [nan] as equal to itself and less than any other float
+ value. This treatment of [nan] ensures that [compare] defines a total
+ ordering relation. *)
+
+val equal: t -> t -> bool
+(** The equal function for floating-point numbers, compared using {!compare}. *)
+
+val min : t -> t -> t
+(** [min x y] returns the minimum of [x] and [y]. It returns [nan]
+ when [x] or [y] is [nan]. Moreover [min (-0.) (+0.) = -0.]
+
+ @since 4.08.0 *)
+
+val max : float -> float -> float
+(** [max x y] returns the maximum of [x] and [y]. It returns [nan]
+ when [x] or [y] is [nan]. Moreover [max (-0.) (+0.) = +0.]
+
+ @since 4.08.0 *)
+
+val min_max : float -> float -> float * float
+(** [min_max x y] is [(min x y, max x y)], just more efficient.
+
+ @since 4.08.0 *)
+
+val min_num : t -> t -> t
+(** [min_num x y] returns the minimum of [x] and [y] treating [nan] as
+ missing values. If both [x] and [y] are [nan], [nan] is returned.
+ Moreover [min_num (-0.) (+0.) = -0.]
+
+ @since 4.08.0 *)
+
+val max_num : t -> t -> t
+(** [max_num x y] returns the maximum of [x] and [y] treating [nan] as
+ missing values. If both [x] and [y] are [nan] [nan] is returned.
+ Moreover [max_num (-0.) (+0.) = +0.]
+
+ @since 4.08.0 *)
+
+val min_max_num : float -> float -> float * float
+(** [min_max_num x y] is [(min_num x y, max_num x y)], just more
+ efficient. Note that in particular [min_max_num x nan = (x, x)]
+ and [min_max_num nan y = (y, y)].
+
+ @since 4.08.0 *)
+
+
+val hash: t -> int
+(** The hash function for floating-point numbers. *)
+
+module Array : sig
+FLOATARRAY
+end
+(** Float arrays with packed representation. *)
+
+module ArrayLabels : sig
+FLOATARRAYLAB
+end
+(** Float arrays with packed representation (labeled functions). *)
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* Nicolas Ojeda Bar, LexiFi *)
+(* *)
+(* Copyright 2018 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+type t = floatarray
+(** The type of float arrays with packed representation.
+ @since 4.08.0
+ *)
+
+val length : t -> int
+(** Return the length (number of elements) of the given floatarray. *)
+
+val get : t -> int -> float
+(** [get a n] returns the element number [n] of floatarray [a].
+ @raise Invalid_argument if [n] is outside the range 0 to
+ [(length a - 1)]. *)
+
+val set : t -> int -> float -> unit
+(** [set a n x] modifies floatarray [a] in place, replacing element
+ number [n] with [x].
+ @raise Invalid_argument if [n] is outside the range 0 to
+ [(length a - 1)]. *)
+
+val make : int -> float -> t
+(** [make n x] returns a fresh floatarray of length [n], initialized with [x].
+ @raise Invalid_argument if [n < 0] or [n > Sys.max_floatarray_length]. *)
+
+val create : int -> t
+(** [create n] returns a fresh floatarray of length [n],
+ with uninitialized data.
+ @raise Invalid_argument if [n < 0] or [n > Sys.max_floatarray_length]. *)
+
+val init : int -> f:(int -> float) -> t
+(** [init n ~f] returns a fresh floatarray of length [n],
+ with element number [i] initialized to the result of [f i].
+ In other terms, [init n ~f] tabulates the results of [f]
+ applied to the integers [0] to [n-1].
+ @raise Invalid_argument if [n < 0] or [n > Sys.max_floatarray_length]. *)
+
+val append : t -> t -> t
+(** [append v1 v2] returns a fresh floatarray containing the
+ concatenation of the floatarrays [v1] and [v2].
+ @raise Invalid_argument if
+ [length v1 + length v2 > Sys.max_floatarray_length]. *)
+
+val concat : t list -> t
+(** Same as {!append}, but concatenates a list of floatarrays. *)
+
+val sub : t -> pos:int -> len:int -> t
+(** [sub a ~pos ~len] returns a fresh floatarray of length [len],
+ containing the elements number [pos] to [pos + len - 1]
+ of floatarray [a].
+ @raise Invalid_argument if [pos] and [len] do not
+ designate a valid subarray of [a]; that is, if
+ [pos < 0], or [len < 0], or [pos + len > length a]. *)
+
+val copy : t -> t
+(** [copy a] returns a copy of [a], that is, a fresh floatarray
+ containing the same elements as [a]. *)
+
+val fill : t -> pos:int -> len:int -> float -> unit
+(** [fill a ~pos ~len x] modifies the floatarray [a] in place,
+ storing [x] in elements number [pos] to [pos + len - 1].
+ @raise Invalid_argument if [pos] and [len] do not
+ designate a valid subarray of [a]. *)
+
+val blit : src:t -> src_pos:int -> dst:t -> dst_pos:int -> len:int -> unit
+(** [blit ~src ~src_pos ~dst ~dst_pos ~len] copies [len] elements
+ from floatarray [src], starting at element number [src_pos],
+ to floatarray [dst], starting at element number [dst_pos].
+ It works correctly even if
+ [src] and [dst] are the same floatarray, and the source and
+ destination chunks overlap.
+ @raise Invalid_argument if [src_pos] and [len] do not
+ designate a valid subarray of [src], or if [dst_pos] and [len] do not
+ designate a valid subarray of [dst]. *)
+
+val to_list : t -> float list
+(** [to_list a] returns the list of all the elements of [a]. *)
+
+val of_list : float list -> t
+(** [of_list l] returns a fresh floatarray containing the elements
+ of [l].
+ @raise Invalid_argument if the length of [l] is greater than
+ [Sys.max_floatarray_length].*)
+
+(** {2 Iterators} *)
+
+val iter : f:(float -> unit) -> t -> unit
+(** [iter ~f a] applies function [f] in turn to all
+ the elements of [a]. It is equivalent to
+ [f a.(0); f a.(1); ...; f a.(length a - 1); ()]. *)
+
+val iteri : f:(int -> float -> unit) -> t -> unit
+(** Same as {!iter}, but the
+ function is applied with the index of the element as first argument,
+ and the element itself as second argument. *)
+
+val map : f:(float -> float) -> t -> t
+(** [map ~f a] applies function [f] to all the elements of [a],
+ and builds a floatarray with the results returned by [f]. *)
+
+val mapi : f:(int -> float -> float) -> t -> t
+(** Same as {!map}, but the
+ function is applied to the index of the element as first argument,
+ and the element itself as second argument. *)
+
+val fold_left : f:('a -> float -> 'a) -> init:'a -> t -> 'a
+(** [fold_left ~f x ~init] computes
+ [f (... (f (f x init.(0)) init.(1)) ...) init.(n-1)],
+ where [n] is the length of the floatarray [init]. *)
+
+val fold_right : f:(float -> 'a -> 'a) -> t -> init:'a -> 'a
+(** [fold_right f a init] computes
+ [f a.(0) (f a.(1) ( ... (f a.(n-1) init) ...))],
+ where [n] is the length of the floatarray [a]. *)
+
+(** {2 Iterators on two arrays} *)
+
+val iter2 : f:(float -> float -> unit) -> t -> t -> unit
+(** [Array.iter2 ~f a b] applies function [f] to all the elements of [a]
+ and [b].
+ @raise Invalid_argument if the floatarrays are not the same size. *)
+
+val map2 : f:(float -> float -> float) -> t -> t -> t
+(** [map2 ~f a b] applies function [f] to all the elements of [a]
+ and [b], and builds a floatarray with the results returned by [f]:
+ [[| f a.(0) b.(0); ...; f a.(length a - 1) b.(length b - 1)|]].
+ @raise Invalid_argument if the floatarrays are not the same size. *)
+
+(** {2 Array scanning} *)
+
+val for_all : f:(float -> bool) -> t -> bool
+(** [for_all ~f [|a1; ...; an|]] checks if all elements of the floatarray
+ satisfy the predicate [f]. That is, it returns
+ [(f a1) && (f a2) && ... && (f an)]. *)
+
+val exists : f:(float -> bool) -> t -> bool
+(** [exists f [|a1; ...; an|]] checks if at least one element of
+ the floatarray satisfies the predicate [f]. That is, it returns
+ [(f a1) || (f a2) || ... || (f an)]. *)
+
+val mem : float -> set:t -> bool
+(** [mem a ~set] is true if and only if there is an element of [set] that is
+ structurally equal to [a], i.e. there is an [x] in [set] such
+ that [compare a x = 0]. *)
+
+val mem_ieee : float -> set:t -> bool
+(** Same as {!mem}, but uses IEEE equality instead of structural equality. *)
+
+(** {2 Sorting} *)
+
+val sort : cmp:(float -> float -> int) -> t -> unit
+(** Sort a floatarray in increasing order according to a comparison
+ function. The comparison function must return 0 if its arguments
+ compare as equal, a positive integer if the first is greater,
+ and a negative integer if the first is smaller (see below for a
+ complete specification). For example, {!Stdlib.compare} is
+ a suitable comparison function. After calling [sort], the
+ array is sorted in place in increasing order.
+ [sort] is guaranteed to run in constant heap space
+ and (at most) logarithmic stack space.
+
+ The current implementation uses Heap Sort. It runs in constant
+ stack space.
+
+ Specification of the comparison function:
+ Let [a] be the floatarray and [cmp] the comparison function. The following
+ must be true for all [x], [y], [z] in [a] :
+- [cmp x y] > 0 if and only if [cmp y x] < 0
+- if [cmp x y] >= 0 and [cmp y z] >= 0 then [cmp x z] >= 0
+
+ When [sort] returns, [a] contains the same elements as before,
+ reordered in such a way that for all i and j valid indices of [a] :
+- [cmp a.(i) a.(j)] >= 0 if and only if i >= j
+*)
+
+val stable_sort : cmp:(float -> float -> int) -> t -> unit
+(** Same as {!sort}, but the sorting algorithm is stable (i.e.
+ elements that compare equal are kept in their original order) and
+ not guaranteed to run in constant heap space.
+
+ The current implementation uses Merge Sort. It uses a temporary
+ floatarray of length [n/2], where [n] is the length of the floatarray.
+ It is usually faster than the current implementation of {!sort}. *)
+
+val fast_sort : cmp:(float -> float -> int) -> t -> unit
+(** Same as {!sort} or {!stable_sort}, whichever is faster
+ on typical input. *)
+
+(** {2 Iterators} *)
+
+val to_seq : t -> float Seq.t
+(** Iterate on the floatarray, in increasing order. Modifications of the
+ floatarray during iteration will be reflected in the iterator. *)
+
+val to_seqi : t -> (int * float) Seq.t
+(** Iterate on the floatarray, in increasing order, yielding indices along
+ elements. Modifications of the floatarray during iteration will be
+ reflected in the iterator. *)
+
+val of_seq : float Seq.t -> t
+(** Create an array from the generator. *)
+
+
+val map_to_array : f:(float -> 'a) -> t -> 'a array
+(** [map_to_array ~f a] applies function [f] to all the elements of [a],
+ and builds an array with the results returned by [f]:
+ [[| f a.(0); f a.(1); ...; f a.(length a - 1) |]]. *)
+
+val map_from_array : f:('a -> float) -> 'a array -> t
+(** [map_from_array ~f a] applies function [f] to all the elements of [a],
+ and builds a floatarray with the results returned by [f]. *)
+
+(**/**)
+
+(** {2 Undocumented functions} *)
+
+(* These functions are for system use only. Do not call directly. *)
+external unsafe_get : t -> int -> float = "%floatarray_unsafe_get"
+external unsafe_set : t -> int -> float -> unit = "%floatarray_unsafe_set"
--- /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. *)
+(* *)
+(**************************************************************************)
+
+(* NOTE: If this file is hashtbl.mli, do not edit it directly! Instead,
+ edit templates/hashtbl.template.mli and run tools/sync_stdlib_docs *)
+
+(** Hash tables and hash functions.
+
+ Hash tables are hashed association tables, with in-place modification.
+*)
+
+
+(** {1 Generic interface} *)
+
+
+type (!'a, !'b) t
+(** The type of hash tables from type ['a] to type ['b]. *)
+
+val create : ?random: (* thwart tools/sync_stdlib_docs *) bool ->
+ int -> ('a, 'b) t
+(** [Hashtbl.create n] creates a new, empty hash table, with
+ initial size [n]. For best results, [n] should be on the
+ order of the expected number of elements that will be in
+ the table. The table grows as needed, so [n] is just an
+ initial guess.
+
+ The optional [~][random] parameter (a boolean) controls whether
+ the internal organization of the hash table is randomized at each
+ execution of [Hashtbl.create] or deterministic over all executions.
+
+ A hash table that is created with [~][random] set to [false] uses a
+ fixed hash function ({!hash}) to distribute keys among
+ buckets. As a consequence, collisions between keys happen
+ deterministically. In Web-facing applications or other
+ security-sensitive applications, the deterministic collision
+ patterns can be exploited by a malicious user to create a
+ denial-of-service attack: the attacker sends input crafted to
+ create many collisions in the table, slowing the application down.
+
+ A hash table that is created with [~][random] set to [true] uses the seeded
+ hash function {!seeded_hash} with a seed that is randomly chosen at hash
+ table creation time. In effect, the hash function used is randomly
+ selected among [2^{30}] different hash functions. All these hash
+ functions have different collision patterns, rendering ineffective the
+ denial-of-service attack described above. However, because of
+ randomization, enumerating all elements of the hash table using {!fold}
+ or {!iter} is no longer deterministic: elements are enumerated in
+ different orders at different runs of the program.
+
+ If no [~][random] parameter is given, hash tables are created
+ in non-random mode by default. This default can be changed
+ either programmatically by calling {!randomize} or by
+ setting the [R] flag in the [OCAMLRUNPARAM] environment variable.
+
+ @before 4.00.0 the [~][random] parameter was not present and all
+ hash tables were created in non-randomized mode. *)
+
+val clear : ('a, 'b) t -> unit
+(** Empty a hash table. Use [reset] instead of [clear] to shrink the
+ size of the bucket table to its initial size. *)
+
+val reset : ('a, 'b) t -> unit
+(** Empty a hash table and shrink the size of the bucket table
+ to its initial size.
+ @since 4.00.0 *)
+
+val copy : ('a, 'b) t -> ('a, 'b) t
+(** Return a copy of the given hashtable. *)
+
+val add : ('a, 'b) t -> key:'a -> data:'b -> unit
+(** [Hashtbl.add tbl ~key ~data] adds a binding of [key] to [data]
+ in table [tbl].
+ Previous bindings for [key] are not removed, but simply
+ hidden. That is, after performing {!remove}[ tbl key],
+ the previous binding for [key], if any, is restored.
+ (Same behavior as with association lists.) *)
+
+val find : ('a, 'b) t -> 'a -> 'b
+(** [Hashtbl.find tbl x] returns the current binding of [x] in [tbl],
+ or raises [Not_found] if no such binding exists. *)
+
+val find_opt : ('a, 'b) t -> 'a -> 'b option
+(** [Hashtbl.find_opt tbl x] returns the current binding of [x] in [tbl],
+ or [None] if no such binding exists.
+ @since 4.05 *)
+
+val find_all : ('a, 'b) t -> 'a -> 'b list
+(** [Hashtbl.find_all tbl x] returns the list of all data
+ associated with [x] in [tbl].
+ The current binding is returned first, then the previous
+ bindings, in reverse order of introduction in the table. *)
+
+val mem : ('a, 'b) t -> 'a -> bool
+(** [Hashtbl.mem tbl x] checks if [x] is bound in [tbl]. *)
+
+val remove : ('a, 'b) t -> 'a -> unit
+(** [Hashtbl.remove tbl x] removes the current binding of [x] in [tbl],
+ restoring the previous binding if it exists.
+ It does nothing if [x] is not bound in [tbl]. *)
+
+val replace : ('a, 'b) t -> key:'a -> data:'b -> unit
+(** [Hashtbl.replace tbl ~key ~data] replaces the current binding of [key]
+ in [tbl] by a binding of [key] to [data]. If [key] is unbound in [tbl],
+ a binding of [key] to [data] is added to [tbl].
+ This is functionally equivalent to {!remove}[ tbl key]
+ followed by {!add}[ tbl key data]. *)
+
+val iter : f:(key:'a -> data:'b -> unit) -> ('a, 'b) t -> unit
+(** [Hashtbl.iter ~f tbl] applies [f] to all bindings in table [tbl].
+ [f] receives the key as first argument, and the associated value
+ as second argument. Each binding is presented exactly once to [f].
+
+ The order in which the bindings are passed to [f] is unspecified.
+ However, if the table contains several bindings for the same key,
+ they are passed to [f] in reverse order of introduction, that is,
+ the most recent binding is passed first.
+
+ If the hash table was created in non-randomized mode, the order
+ in which the bindings are enumerated is reproducible between
+ successive runs of the program, and even between minor versions
+ of OCaml. For randomized hash tables, the order of enumeration
+ is entirely random.
+
+ The behavior is not defined if the hash table is modified
+ by [f] during the iteration.
+*)
+
+val filter_map_inplace: f:(key:'a -> data:'b -> 'b option) -> ('a, 'b) t ->
+ unit
+(** [Hashtbl.filter_map_inplace ~f tbl] applies [f] to all bindings in
+ table [tbl] and update each binding depending on the result of
+ [f]. If [f] returns [None], the binding is discarded. If it
+ returns [Some new_val], the binding is update to associate the key
+ to [new_val].
+
+ Other comments for {!iter} apply as well.
+ @since 4.03.0 *)
+
+val fold : f:(key:'a -> data:'b -> 'c -> 'c) -> ('a, 'b) t -> init:'c -> 'c
+(** [Hashtbl.fold ~f tbl ~init] computes
+ [(f kN dN ... (f k1 d1 init)...)],
+ where [k1 ... kN] are the keys of all bindings in [tbl],
+ and [d1 ... dN] are the associated values.
+ Each binding is presented exactly once to [f].
+
+ The order in which the bindings are passed to [f] is unspecified.
+ However, if the table contains several bindings for the same key,
+ they are passed to [f] in reverse order of introduction, that is,
+ the most recent binding is passed first.
+
+ If the hash table was created in non-randomized mode, the order
+ in which the bindings are enumerated is reproducible between
+ successive runs of the program, and even between minor versions
+ of OCaml. For randomized hash tables, the order of enumeration
+ is entirely random.
+
+ The behavior is not defined if the hash table is modified
+ by [f] during the iteration.
+*)
+
+val length : ('a, 'b) t -> int
+(** [Hashtbl.length tbl] returns the number of bindings in [tbl].
+ It takes constant time. Multiple bindings are counted once each, so
+ [Hashtbl.length] gives the number of times [Hashtbl.iter] calls its
+ first argument. *)
+
+val randomize : unit -> unit
+(** After a call to [Hashtbl.randomize()], hash tables are created in
+ randomized mode by default: {!create} returns randomized
+ hash tables, unless the [~random:false] optional parameter is given.
+ The same effect can be achieved by setting the [R] parameter in
+ the [OCAMLRUNPARAM] environment variable.
+
+ It is recommended that applications or Web frameworks that need to
+ protect themselves against the denial-of-service attack described
+ in {!create} call [Hashtbl.randomize()] at initialization
+ time.
+
+ Note that once [Hashtbl.randomize()] was called, there is no way
+ to revert to the non-randomized default behavior of {!create}.
+ This is intentional. Non-randomized hash tables can still be
+ created using [Hashtbl.create ~random:false].
+
+ @since 4.00.0 *)
+
+val is_randomized : unit -> bool
+(** Return [true] if the tables are currently created in randomized mode
+ by default, [false] otherwise.
+ @since 4.03.0 *)
+
+val rebuild : ?random (* thwart tools/sync_stdlib_docs *) :bool ->
+ ('a, 'b) t -> ('a, 'b) t
+(** Return a copy of the given hashtable. Unlike {!copy},
+ {!rebuild}[ h] re-hashes all the (key, value) entries of
+ the original table [h]. The returned hash table is randomized if
+ [h] was randomized, or the optional [random] parameter is true, or
+ if the default is to create randomized hash tables; see
+ {!create} for more information.
+
+ {!rebuild} can safely be used to import a hash table built
+ by an old version of the {!Hashtbl} module, then marshaled to
+ persistent storage. After unmarshaling, apply {!rebuild}
+ to produce a hash table for the current version of the {!Hashtbl}
+ module.
+
+ @since 4.12.0 *)
+
+(** @since 4.00.0 *)
+type statistics = {
+ num_bindings: int;
+ (** Number of bindings present in the table.
+ Same value as returned by {!length}. *)
+ num_buckets: int;
+ (** Number of buckets in the table. *)
+ max_bucket_length: int;
+ (** Maximal number of bindings per bucket. *)
+ bucket_histogram: int array
+ (** Histogram of bucket sizes. This array [histo] has
+ length [max_bucket_length + 1]. The value of
+ [histo.(i)] is the number of buckets whose size is [i]. *)
+}
+
+val stats : ('a, 'b) t -> statistics
+(** [Hashtbl.stats tbl] returns statistics about the table [tbl]:
+ number of buckets, size of the biggest bucket, distribution of
+ buckets by size.
+ @since 4.00.0 *)
+
+(** {1 Iterators} *)
+
+val to_seq : ('a,'b) t -> ('a * 'b) Seq.t
+(** Iterate on the whole table. The order in which the bindings
+ appear in the sequence is unspecified. However, if the table contains
+ 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
+ during the iteration.
+
+ @since 4.07 *)
+
+val to_seq_keys : ('a,_) t -> 'a Seq.t
+(** Same as [Seq.map fst (to_seq m)]
+ @since 4.07 *)
+
+val to_seq_values : (_,'b) t -> 'b Seq.t
+(** Same as [Seq.map snd (to_seq m)]
+ @since 4.07 *)
+
+val add_seq : ('a,'b) t -> ('a * 'b) Seq.t -> unit
+(** Add the given bindings to the table, using {!add}
+ @since 4.07 *)
+
+val replace_seq : ('a,'b) t -> ('a * 'b) Seq.t -> unit
+(** Add the given bindings to the table, using {!replace}
+ @since 4.07 *)
+
+val of_seq : ('a * 'b) Seq.t -> ('a, 'b) t
+(** Build a table from the given bindings. The bindings are added
+ in the same order they appear in the sequence, using {!replace_seq},
+ which means that if two pairs have the same key, only the latest one
+ will appear in the table.
+ @since 4.07 *)
+
+(** {1 Functorial interface} *)
+
+(** The functorial interface allows the use of specific comparison
+ and hash functions, either for performance/security concerns,
+ or because keys are not hashable/comparable with the polymorphic builtins.
+
+ For instance, one might want to specialize a table for integer keys:
+ {[
+ module IntHash =
+ struct
+ type t = int
+ let equal i j = i=j
+ let hash i = i land max_int
+ end
+
+ module IntHashtbl = Hashtbl.Make(IntHash)
+
+ let h = IntHashtbl.create 17 in
+ IntHashtbl.add h 12 "hello"
+ ]}
+
+ This creates a new module [IntHashtbl], with a new type ['a
+ IntHashtbl.t] of tables from [int] to ['a]. In this example, [h]
+ contains [string] values so its type is [string IntHashtbl.t].
+
+ Note that the new type ['a IntHashtbl.t] is not compatible with
+ the type [('a,'b) Hashtbl.t] of the generic interface. For
+ example, [Hashtbl.length h] would not type-check, you must use
+ [IntHashtbl.length].
+*)
+
+module type HashedType =
+ sig
+ type t
+ (** The type of the hashtable keys. *)
+
+ val equal : t -> t -> bool
+ (** The equality predicate used to compare keys. *)
+
+ val hash : t -> int
+ (** A hashing function on keys. It must be such that if two keys are
+ equal according to [equal], then they have identical hash values
+ as computed by [hash].
+ Examples: suitable ([equal], [hash]) pairs for arbitrary key
+ types include
+- ([(=)], {!hash}) for comparing objects by structure
+ (provided objects do not contain floats)
+- ([(fun x y -> compare x y = 0)], {!hash})
+ for comparing objects by structure
+ and handling {!Stdlib.nan} correctly
+- ([(==)], {!hash}) for comparing objects by physical
+ equality (e.g. for mutable or cyclic objects). *)
+ end
+(** The input signature of the functor {!Make}. *)
+
+module type S =
+ sig
+ type key
+ type !'a t
+ val create : int -> 'a t
+ val clear : 'a t -> unit
+ val reset : 'a t -> unit (** @since 4.00.0 *)
+
+ val copy : 'a t -> 'a t
+ val add : 'a t -> key:key -> data:'a -> unit
+ val remove : 'a t -> key -> unit
+ val find : 'a t -> key -> 'a
+ val find_opt : 'a t -> key -> 'a option
+ (** @since 4.05.0 *)
+
+ val find_all : 'a t -> key -> 'a list
+ val replace : 'a t -> key:key -> data:'a -> unit
+ val mem : 'a t -> key -> bool
+ val iter : f:(key:key -> data:'a -> unit) -> 'a t -> unit
+ val filter_map_inplace: f:(key:key -> data:'a -> 'a option) -> 'a t ->
+ unit
+ (** @since 4.03.0 *)
+
+ val fold : f:(key:key -> data:'a -> 'b -> 'b) -> 'a t -> init:'b -> 'b
+ val length : 'a t -> int
+ val stats: 'a t -> statistics (** @since 4.00.0 *)
+
+ val to_seq : 'a t -> (key * 'a) Seq.t
+ (** @since 4.07 *)
+
+ val to_seq_keys : _ t -> key Seq.t
+ (** @since 4.07 *)
+
+ val to_seq_values : 'a t -> 'a Seq.t
+ (** @since 4.07 *)
+
+ val add_seq : 'a t -> (key * 'a) Seq.t -> unit
+ (** @since 4.07 *)
+
+ val replace_seq : 'a t -> (key * 'a) Seq.t -> unit
+ (** @since 4.07 *)
+
+ val of_seq : (key * 'a) Seq.t -> 'a t
+ (** @since 4.07 *)
+ end
+(** The output signature of the functor {!Make}. *)
+
+module Make (H : HashedType) : S with type key = H.t
+(** Functor building an implementation of the hashtable structure.
+ The functor [Hashtbl.Make] returns a structure containing
+ a type [key] of keys and a type ['a t] of hash tables
+ associating data of type ['a] to keys of type [key].
+ The operations perform similarly to those of the generic
+ interface, but use the hashing and equality functions
+ specified in the functor argument [H] instead of generic
+ equality and hashing. Since the hash function is not seeded,
+ the [create] operation of the result structure always returns
+ non-randomized hash tables. *)
+
+module type SeededHashedType =
+ sig
+ type t
+ (** The type of the hashtable keys. *)
+
+ val equal: t -> t -> bool
+ (** The equality predicate used to compare keys. *)
+
+ val hash: int -> t -> int
+ (** 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. *)
+ end
+(** The input signature of the functor {!MakeSeeded}.
+ @since 4.00.0 *)
+
+module type SeededS =
+ sig
+ 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:key -> data:'a -> unit
+ val remove : 'a t -> key -> unit
+ val find : 'a t -> key -> 'a
+ val find_opt : 'a t -> key -> 'a option (** @since 4.05.0 *)
+
+ val find_all : 'a t -> key -> 'a list
+ val replace : 'a t -> key:key -> data:'a -> unit
+ val mem : 'a t -> key -> bool
+ val iter : f:(key:key -> data:'a -> unit) -> 'a t -> unit
+ val filter_map_inplace: f:(key:key -> data:'a -> 'a option) -> 'a t ->
+ unit
+ (** @since 4.03.0 *)
+
+ val fold : f:(key:key -> data:'a -> 'b -> 'b) -> 'a t -> init:'b -> 'b
+ val length : 'a t -> int
+ val stats: 'a t -> statistics
+
+ val to_seq : 'a t -> (key * 'a) Seq.t
+ (** @since 4.07 *)
+
+ val to_seq_keys : _ t -> key Seq.t
+ (** @since 4.07 *)
+
+ val to_seq_values : 'a t -> 'a Seq.t
+ (** @since 4.07 *)
+
+ val add_seq : 'a t -> (key * 'a) Seq.t -> unit
+ (** @since 4.07 *)
+
+ val replace_seq : 'a t -> (key * 'a) Seq.t -> unit
+ (** @since 4.07 *)
+
+ val of_seq : (key * 'a) Seq.t -> 'a t
+ (** @since 4.07 *)
+ end
+(** The output signature of the functor {!MakeSeeded}.
+ @since 4.00.0 *)
+
+module MakeSeeded (H : SeededHashedType) : SeededS with type key = H.t
+(** Functor building an implementation of the hashtable structure.
+ The functor [Hashtbl.MakeSeeded] returns a structure containing
+ a type [key] of keys and a type ['a t] of hash tables
+ associating data of type ['a] to keys of type [key].
+ The operations perform similarly to those of the generic
+ interface, but use the seeded hashing and equality functions
+ specified in the functor argument [H] instead of generic
+ equality and hashing. The [create] operation of the
+ result structure supports the [~][random] optional parameter
+ and returns randomized hash tables if [~random:true] is passed
+ or if randomization is globally on (see {!Hashtbl.randomize}).
+ @since 4.00.0 *)
+
+
+(** {1 The polymorphic hash functions} *)
+
+
+val hash : 'a -> int
+(** [Hashtbl.hash x] associates a nonnegative integer to any value of
+ any type. It is guaranteed that
+ if [x = y] or [Stdlib.compare x y = 0], then [hash x = hash y].
+ Moreover, [hash] always terminates, even on cyclic structures. *)
+
+val seeded_hash : int -> 'a -> int
+(** A variant of {!hash} that is further parameterized by
+ an integer seed.
+ @since 4.00.0 *)
+
+val hash_param : int -> int -> 'a -> int
+(** [Hashtbl.hash_param meaningful total x] computes a hash value for [x],
+ with the same properties as for [hash]. The two extra integer
+ parameters [meaningful] and [total] give more precise control over
+ hashing. Hashing performs a breadth-first, left-to-right traversal
+ of the structure [x], stopping after [meaningful] meaningful nodes
+ were encountered, or [total] nodes (meaningful or not) were
+ encountered. If [total] as specified by the user exceeds a certain
+ value, currently 256, then it is capped to that value.
+ Meaningful nodes are: integers; floating-point
+ numbers; strings; characters; booleans; and constant
+ constructors. Larger values of [meaningful] and [total] means that
+ more nodes are taken into account to compute the final hash value,
+ and therefore collisions are less likely to happen. However,
+ hashing takes longer. The parameters [meaningful] and [total]
+ govern the tradeoff between accuracy and speed. As default
+ choices, {!hash} and {!seeded_hash} take
+ [meaningful = 10] and [total = 100]. *)
+
+val seeded_hash_param : int -> int -> int -> 'a -> int
+(** A variant of {!hash_param} that is further parameterized by
+ an integer seed. Usage:
+ [Hashtbl.seeded_hash_param meaningful total seed x].
+ @since 4.00.0 *)
--- /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. *)
+(* *)
+(**************************************************************************)
+
+(* NOTE: If this file is map.mli, do not edit it directly! Instead,
+ edit templates/map.template.mli and run tools/sync_stdlib_docs *)
+
+(** Association tables over ordered types.
+
+ This module implements applicative association tables, also known as
+ finite maps or dictionaries, given a total ordering function
+ over the keys.
+ All operations over maps are purely applicative (no side-effects).
+ The implementation uses balanced binary trees, and therefore searching
+ and insertion take time logarithmic in the size of the map.
+
+ For instance:
+ {[
+ module IntPairs =
+ struct
+ type t = int * int
+ let compare (x0,y0) (x1,y1) =
+ match Stdlib.compare x0 x1 with
+ 0 -> Stdlib.compare y0 y1
+ | c -> c
+ end
+
+ module PairsMap = Map.Make(IntPairs)
+
+ let m = PairsMap.(empty |> add (0,1) "hello" |> add (1,0) "world")
+ ]}
+
+ This creates a new module [PairsMap], with a new type ['a PairsMap.t]
+ of maps from [int * int] to ['a]. In this example, [m] contains [string]
+ values so its type is [string PairsMap.t].
+*)
+
+module type OrderedType =
+ sig
+ type t
+ (** The type of the map keys. *)
+
+ val compare : t -> t -> int
+ (** A total ordering function over the keys.
+ This is a two-argument function [f] such that
+ [f e1 e2] is zero if the keys [e1] and [e2] are equal,
+ [f e1 e2] is strictly negative if [e1] is smaller than [e2],
+ and [f e1 e2] is strictly positive if [e1] is greater than [e2].
+ Example: a suitable ordering function is the generic structural
+ comparison function {!Stdlib.compare}. *)
+ end
+(** Input signature of the functor {!Make}. *)
+
+module type S =
+ sig
+ type key
+ (** The type of the map keys. *)
+
+ type !+'a t
+ (** The type of maps from type [key] to type ['a]. *)
+
+ val empty: 'a t
+ (** The empty map. *)
+
+ val is_empty: 'a t -> bool
+ (** Test whether a map is empty or not. *)
+
+ val mem: key -> 'a t -> bool
+ (** [mem x m] returns [true] if [m] contains a binding for [x],
+ and [false] otherwise. *)
+
+ val add: key:key -> data:'a -> 'a t -> 'a t
+ (** [add ~key ~data m] returns a map containing the same bindings as
+ [m], plus a binding of [key] to [data]. If [key] was already bound
+ in [m] to a value that is physically equal to [data],
+ [m] is returned unchanged (the result of the function is
+ then physically equal to [m]). Otherwise, the previous binding
+ of [key] in [m] disappears.
+ @before 4.03 Physical equality was not ensured. *)
+
+ val update: key:key -> f:('a option -> 'a option) -> 'a t -> 'a t
+ (** [update ~key ~f m] returns a map containing the same bindings as
+ [m], except for the binding of [key]. Depending on the value of
+ [y] where [y] is [f (find_opt key m)], the binding of [key] is
+ added, removed or updated. If [y] is [None], the binding is
+ removed if it exists; otherwise, if [y] is [Some z] then [key]
+ is associated to [z] in the resulting map. If [key] was already
+ bound in [m] to a value that is physically equal to [z], [m]
+ is returned unchanged (the result of the function is then
+ physically equal to [m]).
+ @since 4.06.0
+ *)
+
+ val singleton: key -> 'a -> 'a t
+ (** [singleton x y] returns the one-element map that contains a binding
+ [y] for [x].
+ @since 3.12.0
+ *)
+
+ val remove: key -> 'a t -> 'a t
+ (** [remove x m] returns a map containing the same bindings as
+ [m], except for [x] which is unbound in the returned map.
+ If [x] was not in [m], [m] is returned unchanged
+ (the result of the function is then physically equal to [m]).
+ @before 4.03 Physical equality was not ensured. *)
+
+ val merge:
+ f:(key -> 'a option -> 'b option -> 'c option) ->
+ 'a t -> 'b t -> 'c t
+ (** [merge ~f m1 m2] computes a map whose keys are a subset of the keys of
+ [m1] and of [m2]. The presence of each such binding, and the
+ corresponding value, is determined with the function [f].
+ In terms of the [find_opt] operation, we have
+ [find_opt x (merge f m1 m2) = f x (find_opt x m1) (find_opt x m2)]
+ for any key [x], provided that [f x None None = None].
+ @since 3.12.0
+ *)
+
+ val union: f:(key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
+ (** [union ~f m1 m2] computes a map whose keys are a subset of the keys
+ of [m1] and of [m2]. When the same binding is defined in both
+ arguments, the function [f] is used to combine them.
+ This is a special case of [merge]: [union f m1 m2] is equivalent
+ to [merge f' m1 m2], where
+ - [f' _key None None = None]
+ - [f' _key (Some v) None = Some v]
+ - [f' _key None (Some v) = Some v]
+ - [f' key (Some v1) (Some v2) = f key v1 v2]
+
+ @since 4.03.0
+ *)
+
+ val compare: cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int
+ (** Total ordering between maps. The first argument is a total ordering
+ used to compare data associated with equal keys in the two maps. *)
+
+ val equal: cmp:('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+ (** [equal ~cmp m1 m2] tests whether the maps [m1] and [m2] are
+ equal, that is, contain equal keys and associate them with
+ equal data. [cmp] is the equality predicate used to compare
+ the data associated with the keys. *)
+
+ val iter: f:(key:key -> data:'a -> unit) -> 'a t -> unit
+ (** [iter ~f m] applies [f] to all bindings in map [m].
+ [f] receives the key as first argument, and the associated value
+ as second argument. The bindings are passed to [f] in increasing
+ order with respect to the ordering over the type of the keys. *)
+
+ val fold: f:(key:key -> data:'a -> 'b -> 'b) -> 'a t -> init:'b -> 'b
+ (** [fold ~f m ~init] computes [(f kN dN ... (f k1 d1 init)...)],
+ where [k1 ... kN] are the keys of all bindings in [m]
+ (in increasing order), and [d1 ... dN] are the associated data. *)
+
+ val for_all: f:(key -> 'a -> bool) -> 'a t -> bool
+ (** [for_all ~f m] checks if all the bindings of the map
+ satisfy the predicate [f].
+ @since 3.12.0
+ *)
+
+ val exists: f:(key -> 'a -> bool) -> 'a t -> bool
+ (** [exists ~f m] checks if at least one binding of the map
+ satisfies the predicate [f].
+ @since 3.12.0
+ *)
+
+ val filter: f:(key -> 'a -> bool) -> 'a t -> 'a t
+ (** [filter ~f m] returns the map with all the bindings in [m]
+ that satisfy predicate [p]. If every binding in [m] satisfies [f],
+ [m] is returned unchanged (the result of the function is then
+ physically equal to [m])
+ @since 3.12.0
+ @before 4.03 Physical equality was not ensured.
+ *)
+
+ val filter_map: f:(key -> 'a -> 'b option) -> 'a t -> 'b t
+ (** [filter_map ~f m] applies the function [f] to every binding of
+ [m], and builds a map from the results. For each binding
+ [(k, v)] in the input map:
+ - if [f k v] is [None] then [k] is not in the result,
+ - if [f k v] is [Some v'] then the binding [(k, v')]
+ is in the output map.
+
+ For example, the following function on maps whose values are lists
+ {[
+ filter_map
+ (fun _k li -> match li with [] -> None | _::tl -> Some tl)
+ m
+ ]}
+ drops all bindings of [m] whose value is an empty list, and pops
+ the first element of each value that is non-empty.
+
+ @since 4.11.0
+ *)
+
+ val partition: f:(key -> 'a -> bool) -> 'a t -> 'a t * 'a t
+ (** [partition ~f m] returns a pair of maps [(m1, m2)], where
+ [m1] contains all the bindings of [m] that satisfy the
+ predicate [f], and [m2] is the map with all the bindings of
+ [m] that do not satisfy [f].
+ @since 3.12.0
+ *)
+
+ val cardinal: 'a t -> int
+ (** Return the number of bindings of a map.
+ @since 3.12.0
+ *)
+
+ val bindings: 'a t -> (key * 'a) list
+ (** 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}.
+ @since 3.12.0
+ *)
+
+ val min_binding: 'a t -> (key * 'a)
+ (** Return the binding with the smallest key in a given map
+ (with respect to the [Ord.compare] ordering), or raise
+ [Not_found] if the map is empty.
+ @since 3.12.0
+ *)
+
+ val min_binding_opt: 'a t -> (key * 'a) option
+ (** Return the binding with the smallest key in the given map
+ (with respect to the [Ord.compare] ordering), or [None]
+ if the map is empty.
+ @since 4.05
+ *)
+
+ val max_binding: 'a t -> (key * 'a)
+ (** Same as {!S.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
+ the largest key in the given map.
+ @since 4.05
+ *)
+
+ val choose: 'a t -> (key * 'a)
+ (** Return one binding of the given map, or raise [Not_found] if
+ the map is empty. Which binding is chosen is unspecified,
+ but equal bindings will be chosen for equal maps.
+ @since 3.12.0
+ *)
+
+ val choose_opt: 'a t -> (key * 'a) option
+ (** Return one binding of the given map, or [None] if
+ the map is empty. Which binding is chosen is unspecified,
+ but equal bindings will be chosen for equal maps.
+ @since 4.05
+ *)
+
+ val split: key -> 'a t -> 'a t * 'a option * 'a t
+ (** [split x m] returns a triple [(l, data, r)], where
+ [l] is the map with all the bindings of [m] whose key
+ is strictly less than [x];
+ [r] is the map with all the bindings of [m] whose key
+ is strictly greater than [x];
+ [data] is [None] if [m] contains no binding for [x],
+ or [Some v] if [m] binds [v] to [x].
+ @since 3.12.0
+ *)
+
+ val find: key -> 'a t -> 'a
+ (** [find x m] returns the current value of [x] in [m],
+ or raises [Not_found] if no binding for [x] exists. *)
+
+ val find_opt: key -> 'a t -> 'a option
+ (** [find_opt x m] returns [Some v] if the current value of [x]
+ in [m] is [v], or [None] if no binding for [x] exists.
+ @since 4.05
+ *)
+
+ val find_first: f:(key -> bool) -> 'a t -> key * 'a
+ (** [find_first ~f m], where [f] is a monotonically increasing function,
+ returns the binding of [m] with the lowest key [k] such that [f k],
+ or raises [Not_found] if no such key exists.
+
+ For example, [find_first (fun k -> Ord.compare k x >= 0) m] will return
+ the first binding [k, v] of [m] where [Ord.compare k x >= 0]
+ (intuitively: [k >= x]), or raise [Not_found] if [x] is greater than
+ any element of [m].
+
+ @since 4.05
+ *)
+
+ val find_first_opt: f:(key -> bool) -> 'a t -> (key * 'a) option
+ (** [find_first_opt ~f m], where [f] is a monotonically increasing
+ function, returns an option containing the binding of [m] with the
+ lowest key [k] such that [f k], or [None] if no such key exists.
+ @since 4.05
+ *)
+
+ val find_last: f:(key -> bool) -> 'a t -> key * 'a
+ (** [find_last ~f m], where [f] is a monotonically decreasing function,
+ returns the binding of [m] with the highest key [k] such that [f k],
+ or raises [Not_found] if no such key exists.
+ @since 4.05
+ *)
+
+ val find_last_opt: f:(key -> bool) -> 'a t -> (key * 'a) option
+ (** [find_last_opt ~f m], where [f] is a monotonically decreasing
+ function, returns an option containing the binding of [m] with
+ the highest key [k] such that [f k], or [None] if no such key
+ exists.
+ @since 4.05
+ *)
+
+ val map: f:('a -> 'b) -> 'a t -> 'b t
+ (** [map ~f m] returns a map with same domain as [m], where the
+ associated value [a] of all bindings of [m] has been
+ replaced by the result of the application of [f] to [a].
+ The bindings are passed to [f] in increasing order
+ 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
+ key and the associated value for each binding of the map. *)
+
+ (** {1 Iterators} *)
+
+ val to_seq : 'a t -> (key * 'a) Seq.t
+ (** Iterate on the whole map, in ascending order of keys
+ @since 4.07 *)
+
+ val to_rev_seq : 'a t -> (key * 'a) Seq.t
+ (** Iterate on the whole map, in descending order of keys
+ @since 4.12 *)
+
+ val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
+ (** [to_seq_from k m] iterates on a subset of the bindings of [m],
+ in ascending order of keys, from key [k] or above.
+ @since 4.07 *)
+
+ val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
+ (** Add the given bindings to the map, in order.
+ @since 4.07 *)
+
+ val of_seq : (key * 'a) Seq.t -> 'a t
+ (** Build a map from the given bindings
+ @since 4.07 *)
+ end
+(** Output signature of the functor {!Make}. *)
+
+module Make (Ord : OrderedType) : S with type key = Ord.t
+(** Functor building an implementation of the map structure
+ given a totally ordered type. *)
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Jacques Garrigue, Kyoto University RIMS *)
+(* *)
+(* Copyright 2001 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(* NOTE: Do not edit this file directly. Edit templates/ and run
+ tools/sync_stdlib_docs *)
+
+(** Extra labeled libraries.
+
+ This meta-module provides labelized versions of the {!Hashtbl}, {!Map} and
+ {!Set} modules.
+
+ This module is intended to be used through [open MoreLabels] which replaces
+ {!Hashtbl}, {!Map}, and {!Set} with their labeled counterparts.
+
+ For example:
+ {[
+ open MoreLabels
+
+ Hashtbl.iter ~f:(fun ~key ~data -> g key data) table
+ ]}
+*)
+
+module Hashtbl : sig
+HASHTBL
+end
+
+module Map : sig
+MAP
+end
+
+module Set : sig
+SET
+end
--- /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. *)
+(* *)
+(**************************************************************************)
+
+(* NOTE: If this file is set.mli, do not edit it directly! Instead,
+ edit templates/set.template.mli and run tools/sync_stdlib_docs *)
+
+(** Sets over ordered types.
+
+ This module implements the set data structure, given a total ordering
+ function over the set elements. All operations over sets
+ are purely applicative (no side-effects).
+ The implementation uses balanced binary trees, and is therefore
+ reasonably efficient: insertion and membership take time
+ logarithmic in the size of the set, for instance.
+
+ The {!Make} functor constructs implementations for any type, given a
+ [compare] function.
+ For instance:
+ {[
+ module IntPairs =
+ struct
+ type t = int * int
+ let compare (x0,y0) (x1,y1) =
+ match Stdlib.compare x0 x1 with
+ 0 -> Stdlib.compare y0 y1
+ | c -> c
+ end
+
+ module PairsSet = Set.Make(IntPairs)
+
+ let m = PairsSet.(empty |> add (2,3) |> add (5,7) |> add (11,13))
+ ]}
+
+ This creates a new module [PairsSet], with a new type [PairsSet.t]
+ of sets of [int * int].
+*)
+
+module type OrderedType =
+ sig
+ type t
+ (** The type of the set elements. *)
+
+ val compare : t -> t -> int
+ (** A total ordering function over the set elements.
+ This is a two-argument function [f] such that
+ [f e1 e2] is zero if the elements [e1] and [e2] are equal,
+ [f e1 e2] is strictly negative if [e1] is smaller than [e2],
+ and [f e1 e2] is strictly positive if [e1] is greater than [e2].
+ Example: a suitable ordering function is the generic structural
+ comparison function {!Stdlib.compare}. *)
+ end
+(** Input signature of the functor {!Make}. *)
+
+module type S =
+ sig
+ type elt
+ (** The type of the set elements. *)
+
+ type t
+ (** The type of sets. *)
+
+ val empty: t
+ (** The empty set. *)
+
+ val is_empty: t -> bool
+ (** Test whether a set is empty or not. *)
+
+ val mem: elt -> t -> bool
+ (** [mem x s] tests whether [x] belongs to the set [s]. *)
+
+ val add: elt -> t -> t
+ (** [add x s] returns a set containing all elements of [s],
+ plus [x]. If [x] was already in [s], [s] is returned unchanged
+ (the result of the function is then physically equal to [s]).
+ @before 4.03 Physical equality was not ensured. *)
+
+ val singleton: elt -> t
+ (** [singleton x] returns the one-element set containing only [x]. *)
+
+ val remove: elt -> t -> t
+ (** [remove x s] returns a set containing all elements of [s],
+ except [x]. If [x] was not in [s], [s] is returned unchanged
+ (the result of the function is then physically equal to [s]).
+ @before 4.03 Physical equality was not ensured. *)
+
+ val union: t -> t -> t
+ (** Set union. *)
+
+ val inter: t -> t -> t
+ (** Set intersection. *)
+
+ val disjoint: t -> t -> bool
+ (** Test if two sets are disjoint.
+ @since 4.08.0 *)
+
+ val diff: t -> t -> t
+ (** Set difference: [diff s1 s2] contains the elements of [s1]
+ that are not in [s2]. *)
+
+ val compare: t -> t -> int
+ (** Total ordering between sets. Can be used as the ordering function
+ for doing sets of sets. *)
+
+ val equal: t -> t -> bool
+ (** [equal s1 s2] tests whether the sets [s1] and [s2] are
+ equal, that is, contain equal elements. *)
+
+ val subset: t -> t -> bool
+ (** [subset s1 s2] tests whether the set [s1] is a subset of
+ the set [s2]. *)
+
+ val iter: f:(elt -> unit) -> t -> unit
+ (** [iter ~f s] applies [f] in turn to all elements of [s].
+ The elements of [s] are presented to [f] in increasing order
+ with respect to the ordering over the type of the elements. *)
+
+ val map: f:(elt -> elt) -> t -> t
+ (** [map ~f s] is the set whose elements are [f a0],[f a1]... [f
+ aN], where [a0],[a1]...[aN] are the elements of [s].
+
+ The elements are passed to [f] in increasing order
+ with respect to the ordering over the type of the elements.
+
+ If no element of [s] is changed by [f], [s] is returned
+ unchanged. (If each output of [f] is physically equal to its
+ input, the returned set is physically equal to [s].)
+ @since 4.04.0 *)
+
+ val fold: f:(elt -> 'a -> 'a) -> t -> init:'a -> 'a
+ (** [fold ~f s init] computes [(f xN ... (f x2 (f x1 init))...)],
+ where [x1 ... xN] are the elements of [s], in increasing order. *)
+
+ val for_all: f:(elt -> bool) -> t -> bool
+ (** [for_all ~f s] checks if all elements of the set
+ satisfy the predicate [f]. *)
+
+ val exists: f:(elt -> bool) -> t -> bool
+ (** [exists ~f s] checks if at least one element of
+ the set satisfies the predicate [f]. *)
+
+ val filter: f:(elt -> bool) -> t -> t
+ (** [filter ~f s] returns the set of all elements in [s]
+ that satisfy predicate [f]. If [f] satisfies every element in [s],
+ [s] is returned unchanged (the result of the function is then
+ physically equal to [s]).
+ @before 4.03 Physical equality was not ensured.*)
+
+ val filter_map: f:(elt -> elt option) -> t -> t
+ (** [filter_map ~f s] returns the set of all [v] such that
+ [f x = Some v] for some element [x] of [s].
+
+ For example,
+ {[filter_map (fun n -> if n mod 2 = 0 then Some (n / 2) else None) s]}
+ is the set of halves of the even elements of [s].
+
+ If no element of [s] is changed or dropped by [f] (if
+ [f x = Some x] for each element [x]), then
+ [s] is returned unchanged: the result of the function
+ is then physically equal to [s].
+
+ @since 4.11.0
+ *)
+
+ val partition: f:(elt -> bool) -> t -> t * t
+ (** [partition ~f s] returns a pair of sets [(s1, s2)], where
+ [s1] is the set of all the elements of [s] that satisfy the
+ predicate [f], and [s2] is the set of all the elements of
+ [s] that do not satisfy [f]. *)
+
+ val cardinal: t -> int
+ (** Return the number of elements of a set. *)
+
+ val elements: t -> elt list
+ (** 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}. *)
+
+ val min_elt: t -> elt
+ (** Return the smallest element of the given set
+ (with respect to the [Ord.compare] ordering), or raise
+ [Not_found] if the set is empty. *)
+
+ val min_elt_opt: t -> elt option
+ (** Return the smallest element of the given set
+ (with respect to the [Ord.compare] ordering), or [None]
+ if the set is empty.
+ @since 4.05
+ *)
+
+ val max_elt: t -> elt
+ (** Same as {!S.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
+ given set.
+ @since 4.05
+ *)
+
+ val choose: t -> elt
+ (** Return one element of the given set, or raise [Not_found] if
+ the set is empty. Which element is chosen is unspecified,
+ but equal elements will be chosen for equal sets. *)
+
+ val choose_opt: t -> elt option
+ (** Return one element of the given set, or [None] if
+ the set is empty. Which element is chosen is unspecified,
+ but equal elements will be chosen for equal sets.
+ @since 4.05
+ *)
+
+ val split: elt -> t -> t * bool * t
+ (** [split x s] returns a triple [(l, present, r)], where
+ [l] is the set of elements of [s] that are
+ strictly less than [x];
+ [r] is the set of elements of [s] that are
+ strictly greater than [x];
+ [present] is [false] if [s] contains no element equal to [x],
+ or [true] if [s] contains an element equal to [x]. *)
+
+ val find: elt -> t -> elt
+ (** [find x s] returns the element of [s] equal to [x] (according
+ to [Ord.compare]), or raise [Not_found] if no such element
+ exists.
+ @since 4.01.0 *)
+
+ val find_opt: elt -> t -> elt option
+ (** [find_opt x s] returns the element of [s] equal to [x] (according
+ to [Ord.compare]), or [None] if no such element
+ exists.
+ @since 4.05 *)
+
+ val find_first: f:(elt -> bool) -> t -> elt
+ (** [find_first ~f s], where [f] is a monotonically increasing function,
+ returns the lowest element [e] of [s] such that [f e],
+ or raises [Not_found] if no such element exists.
+
+ For example, [find_first (fun e -> Ord.compare e x >= 0) s] will return
+ the first element [e] of [s] where [Ord.compare e x >= 0] (intuitively:
+ [e >= x]), or raise [Not_found] if [x] is greater than any element of
+ [s].
+
+ @since 4.05
+ *)
+
+ val find_first_opt: f:(elt -> bool) -> t -> elt option
+ (** [find_first_opt ~f s], where [f] is a monotonically increasing
+ function, returns an option containing the lowest element [e] of [s]
+ such that [f e], or [None] if no such element exists.
+ @since 4.05
+ *)
+
+ val find_last: f:(elt -> bool) -> t -> elt
+ (** [find_last ~f s], where [f] is a monotonically decreasing function,
+ returns the highest element [e] of [s] such that [f e],
+ or raises [Not_found] if no such element exists.
+ @since 4.05
+ *)
+
+ val find_last_opt: f:(elt -> bool) -> t -> elt option
+ (** [find_last_opt ~f s], where [f] is a monotonically decreasing
+ function, returns an option containing the highest element [e] of [s]
+ such that [f e], or [None] if no such element exists.
+ @since 4.05
+ *)
+
+ val of_list: elt list -> t
+ (** [of_list l] creates a set from a list of elements.
+ This is usually more efficient than folding [add] over the list,
+ except perhaps for lists with many duplicated elements.
+ @since 4.02.0 *)
+
+ (** {1 Iterators} *)
+
+ val to_seq_from : elt -> t -> elt Seq.t
+ (** [to_seq_from x s] iterates on a subset of the elements of [s]
+ in ascending order, from [x] or above.
+ @since 4.07 *)
+
+ val to_seq : t -> elt Seq.t
+ (** Iterate on the whole set, in ascending order
+ @since 4.07 *)
+
+ val to_rev_seq : t -> elt Seq.t
+ (** Iterate on the whole set, in descending order
+ @since 4.12 *)
+
+ val add_seq : elt Seq.t -> t -> t
+ (** Add the given elements to the set, in order.
+ @since 4.07 *)
+
+ val of_seq : elt Seq.t -> t
+ (** Build a set from the given bindings
+ @since 4.07 *)
+ end
+(** Output signature of the functor {!Make}. *)
+
+module Make (Ord : OrderedType) : S with type elt = Ord.t
+(** Functor building an implementation of the set structure
+ given a totally ordered type. *)
@raise Invalid_argument if [u] is {!min}. *)
val is_valid : int -> bool
-(** [is_valid n] is [true] iff [n] is a Unicode scalar value
+(** [is_valid n] is [true] if and only if [n] is a Unicode scalar value
(i.e. in the ranges [0x0000]...[0xD7FF] or [0xE000]...[0x10FFFF]).*)
val of_int : int -> t
(** [to_int u] is [u] as an integer. *)
val is_char : t -> bool
-(** [is_char u] is [true] iff [u] is a latin1 OCaml character. *)
+(** [is_char u] is [true] if and only if [u] is a latin1 OCaml character. *)
val of_char : char -> t
(** [of_char c] is [c] as a Unicode character. *)
(** Weak array operations *)
-type 'a t
+type !'a t
external create : int -> 'a t = "caml_weak_create"
(** {1 Low-level functions} *)
-type 'a t
+type !'a t
(** The type of arrays of weak pointers (weak arrays). A weak
pointer is a value that the garbage collector may erase whenever
the value is not used any more (through normal pointers) by the
.NOTPARALLEL:
BASEDIR := $(shell pwd)
-NO_PRINT=`$(MAKE) empty --no-print-directory >/dev/null 2>&1 \
- && echo --no-print-directory`
FIND=find
TOPDIR := ..
endif
endif
-ifeq "$(FLEXLINK_ENV)" ""
- ocamltest := MKDLL="$(MKDLL)" SORT=$(SORT) MAKE=$(MAKE) $(ocamltest_program)
+ifeq "$(ocamltest_program)" ""
+ ocamltest = $(error ocamltest not found in $(ocamltest_directory))
else
- MKDLL=$(WINTOPDIR)/boot/ocamlrun $(WINTOPDIR)/flexdll/flexlink.exe \
- $(FLEXLINK_FLAGS)
+ ifeq "$(FLEXLINK_ENV)" ""
+ ocamltest := MKDLL="$(MKDLL)" SORT=$(SORT) MAKE=$(MAKE) $(ocamltest_program)
+ else
+ FLEXLINK_DLL_LDFLAGS=$(if $(OC_DLL_LDFLAGS), -link "$(OC_DLL_LDFLAGS)")
+ MKDLL=$(WINTOPDIR)/boot/ocamlrun $(WINTOPDIR)/flexdll/flexlink.exe \
+ $(FLEXLINK_FLAGS) $(FLEXLINK_DLL_LDFLAGS)
- ocamltest := $(FLEXLINK_ENV) MKDLL="$(MKDLL)" SORT=$(SORT) MAKE=$(MAKE) \
- $(ocamltest_program)
+ ocamltest := $(FLEXLINK_ENV) MKDLL="$(MKDLL)" SORT=$(SORT) MAKE=$(MAKE) \
+ $(ocamltest_program)
+ endif
endif
# PROMOTE is only meant to be used internally in recursive calls;
# KEEP_TEST_DIR_ON_SUCCESS should be set by the user (to a non-empty value)
# if they want to pass the -keep-test-dir-on-success option to ocamltest,
-# to preserve test data of succesful tests.
+# to preserve test data of successful tests.
KEEP_TEST_DIR_ON_SUCCESS ?=
ifeq "$(KEEP_TEST_DIR_ON_SUCCESS)" ""
OCAMLTEST_KEEP_TEST_DIR_ON_SUCCESS_FLAG :=
@echo " parallel launch all tests using GNU parallel"
@echo " parallel-foo launch all tests beginning with foo using \
GNU parallel"
- @echo " list FILE=f launch the tests listed in f (one per line)"
+ @echo " one TEST=f launch just this single test"
@echo " one DIR=p launch the tests located in path p"
+ @echo " one LIST=f launch the tests listed in f (one per line)"
@echo " promote DIR=p promote the reference files for the tests in p"
@echo " lib build library modules"
@echo " tools build test tools"
.PHONY: all
all:
@rm -f $(TESTLOG)
- @$(MAKE) $(NO_PRINT) new-without-report
- @$(MAKE) $(NO_PRINT) report
+ @$(MAKE) --no-print-directory new-without-report
+ @$(MAKE) --no-print-directory report
.PHONY: new-without-report
new-without-report: lib tools
@rm -f $(failstamp)
@(IFS=$$(printf "\r\n"); \
- $(ocamltest) -find-test-dirs tests | while read dir; do \
+ $(ocamltest) -find-test-dirs tests | while IFS='' read -r dir; do \
echo Running tests from \'$$dir\' ... ; \
$(MAKE) exec-ocamltest DIR=$$dir \
OCAMLTESTENV=""; \
.PHONY: all-%
all-%: lib tools
@for dir in tests/$**; do \
- $(MAKE) $(NO_PRINT) exec-one DIR=$$dir; \
+ $(MAKE) --no-print-directory exec-one DIR=$$dir; \
done 2>&1 | tee $(TESTLOG)
- @$(MAKE) $(NO_PRINT) retries
@$(MAKE) report
# The targets below use GNU parallel to parallelize tests
exit 1)
@for dir in tests/$**; do echo $$dir; done \
| parallel --gnu --no-notice --keep-order \
- "$(MAKE) $(NO_PRINT) exec-one DIR={} 2>&1" \
+ "$(MAKE) --no-print-directory exec-one DIR={} 2>&1" \
| tee $(TESTLOG)
- @$(MAKE) $(NO_PRINT) retries
@$(MAKE) report
.PHONY: parallel
.PHONY: list
list: lib tools
@if [ -z "$(FILE)" ]; \
- then echo "No value set for variable 'FILE'."; \
- exit 1; \
- fi
- @while read LINE; do \
- $(MAKE) $(NO_PRINT) exec-one DIR=$$LINE; \
- done <$(FILE) 2>&1 | tee $(TESTLOG)
- @$(MAKE) $(NO_PRINT) retries
- @$(MAKE) report
+ then echo "No value set for variable 'FILE'."; \
+ exit 1; \
+ fi
+ @$(MAKE) --no-print-directory one LIST="$(FILE)"
.PHONY: one
one: lib tools
- @if [ -z "$(DIR)" ]; then \
- echo "No value set for variable 'DIR'."; \
- exit 1; \
- fi
- @if [ ! -d $(DIR) ]; then \
- echo "Directory '$(DIR)' does not exist."; \
- exit 1; \
- fi
- @$(MAKE) $(NO_PRINT) exec-one DIR=$(DIR)
+ @case "$(words $(DIR) $(LIST) $(TEST))" in \
+ 0) echo 'No value set for variable DIR, LIST or TEST'>&2; exit 1;; \
+ 1) exit 0;; \
+ *) echo 'Please specify just one of DIR, LIST or TEST'>&2; exit 1;; \
+ esac
+ @if [ -n '$(DIR)' ] && [ ! -d '$(DIR)' ]; then \
+ echo "Directory '$(DIR)' does not exist."; exit 1; \
+ fi
+ @if [ -n '$(TEST)' ] && [ ! -e '$(TEST)' ]; then \
+ echo "Test '$(TEST)' does not exist."; exit 1; \
+ fi
+ @if [ -n '$(LIST)' ] && [ ! -e '$(LIST)' ]; then \
+ echo "File '$(LIST)' does not exist."; exit 1; \
+ fi
+ @if [ -n '$(DIR)' ] ; then \
+ $(MAKE) --no-print-directory exec-one DIR=$(DIR); fi
+ @if [ -n '$(TEST)' ] ; then \
+ TERM=dumb $(OCAMLTESTENV) $(ocamltest) $(OCAMLTESTFLAGS) $(TEST); fi
@$(MAKE) check-failstamp
+ @if [ -n '$(LIST)' ] ; then \
+ while IFS='' read -r LINE; do \
+ $(MAKE) --no-print-directory exec-one DIR=$$LINE ; \
+ done < $$LIST 2>&1 | tee $(TESTLOG) ; \
+ $(MAKE) report ; fi
.PHONY: exec-one
exec-one:
@if [ -z "$(DIR)" ]; then exit 1; fi
@if [ ! -d "$(DIR)" ]; then exit 1; fi
@(IFS=$$(printf "\r\n"); \
- $(ocamltest) -list-tests $(DIR) | while read testfile; do \
+ $(ocamltest) -list-tests $(DIR) | while IFS='' read -r testfile; do \
TERM=dumb $(OCAMLTESTENV) \
$(ocamltest) $(OCAMLTESTFLAGS) $(DIR)/$$testfile || \
echo " ... testing '$$testfile' => unexpected error"; \
report:
@if [ ! -f $(TESTLOG) ]; then echo "No $(TESTLOG) file."; exit 1; fi
@$(AWK) -f ./summarize.awk < $(TESTLOG)
-
-.PHONY: retry-list
-retry-list:
- @while read LINE; do \
- if [ -n "$$LINE" ] ; then \
- echo re-ran $$LINE>> $(TESTLOG); \
- $(MAKE) $(NO_PRINT) clean-one DIR=$$LINE; \
- $(MAKE) $(NO_PRINT) exec-one DIR=$$LINE 2>&1 | tee -a $(TESTLOG) ; \
- fi \
- done <_retries;
- @$(MAKE) $(NO_PRINT) retries
-
-.PHONY: retries
-retries:
- @$(AWK) -v retries=1 -v max_retries=$(MAX_TESTSUITE_DIR_RETRIES) \
- -f ./summarize.awk < $(TESTLOG) > _retries
- @test `cat _retries | wc -l` -eq 0 || $(MAKE) $(NO_PRINT) retry-list
- @rm -f _retries
-
-.PHONY: empty
-empty:
clear();
}
+/^> / {
+ next;
+}
+
/Running tests from '[^']*'/ {
if (in_test) record_unexp();
match($0, /Running tests from '[^']*'/);
printf ("\n#### Some fatal error occurred during testing.\n\n");
exit (3);
}else{
- if (!retries){
- for (key in SKIPPED){
- if (!SKIPPED[key]){
- ++ empty;
- blanks[emptyidx++] = key;
- delete SKIPPED[key];
- }
- }
- for (key in RESULTS){
- r = RESULTS[key];
- if (r == "p"){
- ++ passed;
- }else if (r == "f"){
- ++ failed;
- fail[failidx++] = key;
- }else if (r == "e"){
- ++ unexped;
- unexp[unexpidx++] = key;
- }else if (r == "s"){
- ++ skipped;
- curdir = DIRS[key];
- if (curdir in SKIPPED){
- if (SKIPPED[curdir]){
- SKIPPED[curdir] = 0;
- skips[skipidx++] = curdir;
- }
- }else{
- skips[skipidx++] = key;
- }
- }else if (r == "n"){
- ++ ignored;
- }
- }
- printf("\n");
- if (skipped != 0){
- printf("\nList of skipped tests:\n");
- for (i=0; i < skipidx; i++) printf(" %s\n", skips[i]);
- }
- if (empty != 0){
- printf("\nList of directories returning no results:\n");
- for (i=0; i < empty; i++) printf(" %s\n", blanks[i]);
- }
- if (failed != 0){
- printf("\nList of failed tests:\n");
- for (i=0; i < failed; i++) printf(" %s\n", fail[i]);
- }
- if (unexped != 0){
- printf("\nList of unexpected errors:\n");
- for (i=0; i < unexped; i++) printf(" %s\n", unexp[i]);
- }
- printf("\n");
- printf("Summary:\n");
- printf(" %3d tests passed\n", passed);
- printf(" %3d tests skipped\n", skipped);
- printf(" %3d tests failed\n", failed);
- printf(" %3d tests not started (parent test skipped or failed)\n",
- ignored);
- printf(" %3d unexpected errors\n", unexped);
- printf(" %3d tests considered", nresults);
- if (nresults != passed + skipped + ignored + failed + unexped){
- printf (" (totals don't add up??)");
+ for (key in SKIPPED){
+ if (!SKIPPED[key]){
+ ++ empty;
+ blanks[emptyidx++] = key;
+ delete SKIPPED[key];
}
- printf ("\n");
- if (reran != 0){
- printf(" %3d test dir re-runs\n", reran);
- }
- if (failed || unexped){
- printf("#### Something failed. Exiting with error status.\n\n");
- exit 4;
- }
- }else{
- for (key in RESULTS){
- if (RESULTS[key] == "f" || RESULTS[key] == "e"){
- key = DIRS[key];
- if (!(key in RERUNS)){
- RERUNS[key] = 1;
- if (RERAN[key] < max_retries){
- printf("%s\n", key);
- }
+ }
+ for (key in RESULTS){
+ r = RESULTS[key];
+ if (r == "p"){
+ ++ passed;
+ }else if (r == "f"){
+ ++ failed;
+ fail[failidx++] = key;
+ }else if (r == "e"){
+ ++ unexped;
+ unexp[unexpidx++] = key;
+ }else if (r == "s"){
+ ++ skipped;
+ curdir = DIRS[key];
+ if (curdir in SKIPPED){
+ if (SKIPPED[curdir]){
+ SKIPPED[curdir] = 0;
+ skips[skipidx++] = curdir;
}
+ }else{
+ skips[skipidx++] = key;
}
+ }else if (r == "n"){
+ ++ ignored;
}
}
+ printf("\n");
+ if (skipped != 0){
+ printf("\nList of skipped tests:\n");
+ for (i=0; i < skipidx; i++) printf(" %s\n", skips[i]);
+ }
+ if (empty != 0){
+ printf("\nList of directories returning no results:\n");
+ for (i=0; i < empty; i++) printf(" %s\n", blanks[i]);
+ }
+ if (failed != 0){
+ printf("\nList of failed tests:\n");
+ for (i=0; i < failed; i++) printf(" %s\n", fail[i]);
+ }
+ if (unexped != 0){
+ printf("\nList of unexpected errors:\n");
+ for (i=0; i < unexped; i++) printf(" %s\n", unexp[i]);
+ }
+ printf("\n");
+ printf("Summary:\n");
+ printf(" %3d tests passed\n", passed);
+ printf(" %3d tests skipped\n", skipped);
+ printf(" %3d tests failed\n", failed);
+ printf(" %3d tests not started (parent test skipped or failed)\n",
+ ignored);
+ printf(" %3d unexpected errors\n", unexped);
+ printf(" %3d tests considered", nresults);
+ if (nresults != passed + skipped + ignored + failed + unexped){
+ printf (" (totals don't add up??)");
+ }
+ printf ("\n");
+ if (reran != 0){
+ printf(" %3d test dir re-runs\n", reran);
+ }
+ if (failed || unexped){
+ printf("#### Something failed. Exiting with error status.\n\n");
+ exit 4;
+ }
}
}
File "0001-test.ml", line 1:
-Warning 24: bad source file name: "0001-test" is not a valid module name.
+Warning 24 [bad-module-name]: bad source file name: "0001-test" is not a valid module name.
(* TEST
modules = "is_in_static_data.c"
- * native
+ * naked_pointers
+ ** native
*)
(* Data that should be statically allocated by the compiler (all versions) *)
(* TEST
modules = "is_in_static_data.c is_static_flambda_dep.ml"
* flambda
- ** native
+ ** naked_pointers
+ *** native
*)
(* Data that should be statically allocated by the compiler (flambda only) *)
(* TEST
flags = "-g"
- compare_programs = "false"
* native
*)
modules = "is_in_static_data.c simple_float_const.ml"
* flambda
** flat-float-array
- *** native
+ *** naked_pointers
+ **** native
*)
external is_in_static_data : 'a -> bool = "caml_is_in_static_data"
flags = "-opaque"
* flambda
** flat-float-array
- *** native
+ *** naked_pointers
+ **** native
*)
external is_in_static_data : 'a -> bool = "caml_is_in_static_data"
--- /dev/null
+(* TEST
+files = "mainimmed.c"
+arguments = "-I ${test_source_directory} mainimmed.c"
+* asmgen
+*)
+(* Regenerate with cpp -P immediates.cmmpp > immediates.cmm *)
+(function "testimm" ()
+ (let x (load int "X")
+ (let r "R"
+ (letmut i int 0
+(addraset r i (+ x 0)) (assign i (+ i 1)) (addraset r i (- x 0)) (assign i (+ i 1)) (addraset r i ( * x 0)) (assign i (+ i 1)) (addraset r i (and x 0)) (assign i (+ i 1)) (addraset r i (or x 0)) (assign i (+ i 1)) (addraset r i (xor x 0)) (assign i (+ i 1)) (addraset r i (< x 0)) (assign i (+ i 1)) (checkbound i 0)
+(addraset r i (+ x 1)) (assign i (+ i 1)) (addraset r i (- x 1)) (assign i (+ i 1)) (addraset r i ( * x 1)) (assign i (+ i 1)) (addraset r i (and x 1)) (assign i (+ i 1)) (addraset r i (or x 1)) (assign i (+ i 1)) (addraset r i (xor x 1)) (assign i (+ i 1)) (addraset r i (< x 1)) (assign i (+ i 1)) (checkbound i 1)
+(addraset r i (+ x 0xFF)) (assign i (+ i 1)) (addraset r i (- x 0xFF)) (assign i (+ i 1)) (addraset r i ( * x 0xFF)) (assign i (+ i 1)) (addraset r i (and x 0xFF)) (assign i (+ i 1)) (addraset r i (or x 0xFF)) (assign i (+ i 1)) (addraset r i (xor x 0xFF)) (assign i (+ i 1)) (addraset r i (< x 0xFF)) (assign i (+ i 1)) (checkbound i 0xFF)
+(addraset r i (+ x 0x100)) (assign i (+ i 1)) (addraset r i (- x 0x100)) (assign i (+ i 1)) (addraset r i ( * x 0x100)) (assign i (+ i 1)) (addraset r i (and x 0x100)) (assign i (+ i 1)) (addraset r i (or x 0x100)) (assign i (+ i 1)) (addraset r i (xor x 0x100)) (assign i (+ i 1)) (addraset r i (< x 0x100)) (assign i (+ i 1)) (checkbound i 0x100)
+(addraset r i (+ x 0x3FC)) (assign i (+ i 1)) (addraset r i (- x 0x3FC)) (assign i (+ i 1)) (addraset r i ( * x 0x3FC)) (assign i (+ i 1)) (addraset r i (and x 0x3FC)) (assign i (+ i 1)) (addraset r i (or x 0x3FC)) (assign i (+ i 1)) (addraset r i (xor x 0x3FC)) (assign i (+ i 1)) (addraset r i (< x 0x3FC)) (assign i (+ i 1)) (checkbound i 0x3FC)
+(addraset r i (+ x 0x3FF)) (assign i (+ i 1)) (addraset r i (- x 0x3FF)) (assign i (+ i 1)) (addraset r i ( * x 0x3FF)) (assign i (+ i 1)) (addraset r i (and x 0x3FF)) (assign i (+ i 1)) (addraset r i (or x 0x3FF)) (assign i (+ i 1)) (addraset r i (xor x 0x3FF)) (assign i (+ i 1)) (addraset r i (< x 0x3FF)) (assign i (+ i 1)) (checkbound i 0x3FF)
+(addraset r i (+ x 0x7FF)) (assign i (+ i 1)) (addraset r i (- x 0x7FF)) (assign i (+ i 1)) (addraset r i ( * x 0x7FF)) (assign i (+ i 1)) (addraset r i (and x 0x7FF)) (assign i (+ i 1)) (addraset r i (or x 0x7FF)) (assign i (+ i 1)) (addraset r i (xor x 0x7FF)) (assign i (+ i 1)) (addraset r i (< x 0x7FF)) (assign i (+ i 1)) (checkbound i 0x7FF)
+(addraset r i (+ x 0x800)) (assign i (+ i 1)) (addraset r i (- x 0x800)) (assign i (+ i 1)) (addraset r i ( * x 0x800)) (assign i (+ i 1)) (addraset r i (and x 0x800)) (assign i (+ i 1)) (addraset r i (or x 0x800)) (assign i (+ i 1)) (addraset r i (xor x 0x800)) (assign i (+ i 1)) (addraset r i (< x 0x800)) (assign i (+ i 1)) (checkbound i 0x800)
+(addraset r i (+ x 0x801)) (assign i (+ i 1)) (addraset r i (- x 0x801)) (assign i (+ i 1)) (addraset r i ( * x 0x801)) (assign i (+ i 1)) (addraset r i (and x 0x801)) (assign i (+ i 1)) (addraset r i (or x 0x801)) (assign i (+ i 1)) (addraset r i (xor x 0x801)) (assign i (+ i 1)) (addraset r i (< x 0x801)) (assign i (+ i 1)) (checkbound i 0x801)
+(addraset r i (+ x 0xFFF)) (assign i (+ i 1)) (addraset r i (- x 0xFFF)) (assign i (+ i 1)) (addraset r i ( * x 0xFFF)) (assign i (+ i 1)) (addraset r i (and x 0xFFF)) (assign i (+ i 1)) (addraset r i (or x 0xFFF)) (assign i (+ i 1)) (addraset r i (xor x 0xFFF)) (assign i (+ i 1)) (addraset r i (< x 0xFFF)) (assign i (+ i 1)) (checkbound i 0xFFF)
+(addraset r i (+ x 0x1000)) (assign i (+ i 1)) (addraset r i (- x 0x1000)) (assign i (+ i 1)) (addraset r i ( * x 0x1000)) (assign i (+ i 1)) (addraset r i (and x 0x1000)) (assign i (+ i 1)) (addraset r i (or x 0x1000)) (assign i (+ i 1)) (addraset r i (xor x 0x1000)) (assign i (+ i 1)) (addraset r i (< x 0x1000)) (assign i (+ i 1)) (checkbound i 0x1000)
+(addraset r i (+ x 0x1001)) (assign i (+ i 1)) (addraset r i (- x 0x1001)) (assign i (+ i 1)) (addraset r i ( * x 0x1001)) (assign i (+ i 1)) (addraset r i (and x 0x1001)) (assign i (+ i 1)) (addraset r i (or x 0x1001)) (assign i (+ i 1)) (addraset r i (xor x 0x1001)) (assign i (+ i 1)) (addraset r i (< x 0x1001)) (assign i (+ i 1)) (checkbound i 0x1001)
+(addraset r i (+ x 0x7FFF)) (assign i (+ i 1)) (addraset r i (- x 0x7FFF)) (assign i (+ i 1)) (addraset r i ( * x 0x7FFF)) (assign i (+ i 1)) (addraset r i (and x 0x7FFF)) (assign i (+ i 1)) (addraset r i (or x 0x7FFF)) (assign i (+ i 1)) (addraset r i (xor x 0x7FFF)) (assign i (+ i 1)) (addraset r i (< x 0x7FFF)) (assign i (+ i 1)) (checkbound i 0x7FFF)
+(addraset r i (+ x 0x8000)) (assign i (+ i 1)) (addraset r i (- x 0x8000)) (assign i (+ i 1)) (addraset r i ( * x 0x8000)) (assign i (+ i 1)) (addraset r i (and x 0x8000)) (assign i (+ i 1)) (addraset r i (or x 0x8000)) (assign i (+ i 1)) (addraset r i (xor x 0x8000)) (assign i (+ i 1)) (addraset r i (< x 0x8000)) (assign i (+ i 1)) (checkbound i 0x8000)
+(addraset r i (+ x 0x8001)) (assign i (+ i 1)) (addraset r i (- x 0x8001)) (assign i (+ i 1)) (addraset r i ( * x 0x8001)) (assign i (+ i 1)) (addraset r i (and x 0x8001)) (assign i (+ i 1)) (addraset r i (or x 0x8001)) (assign i (+ i 1)) (addraset r i (xor x 0x8001)) (assign i (+ i 1)) (addraset r i (< x 0x8001)) (assign i (+ i 1)) (checkbound i 0x8001)
+(addraset r i (+ x 0xFFF000)) (assign i (+ i 1)) (addraset r i (- x 0xFFF000)) (assign i (+ i 1)) (addraset r i ( * x 0xFFF000)) (assign i (+ i 1)) (addraset r i (and x 0xFFF000)) (assign i (+ i 1)) (addraset r i (or x 0xFFF000)) (assign i (+ i 1)) (addraset r i (xor x 0xFFF000)) (assign i (+ i 1)) (addraset r i (< x 0xFFF000)) (assign i (+ i 1)) (checkbound i 0xFFF000)
+(addraset r i (+ x 0xFFFFFF)) (assign i (+ i 1)) (addraset r i (- x 0xFFFFFF)) (assign i (+ i 1)) (addraset r i ( * x 0xFFFFFF)) (assign i (+ i 1)) (addraset r i (and x 0xFFFFFF)) (assign i (+ i 1)) (addraset r i (or x 0xFFFFFF)) (assign i (+ i 1)) (addraset r i (xor x 0xFFFFFF)) (assign i (+ i 1)) (addraset r i (< x 0xFFFFFF)) (assign i (+ i 1)) (checkbound i 0xFFFFFF)
+(addraset r i (+ x 0x1000000)) (assign i (+ i 1)) (addraset r i (- x 0x1000000)) (assign i (+ i 1)) (addraset r i ( * x 0x1000000)) (assign i (+ i 1)) (addraset r i (and x 0x1000000)) (assign i (+ i 1)) (addraset r i (or x 0x1000000)) (assign i (+ i 1)) (addraset r i (xor x 0x1000000)) (assign i (+ i 1)) (addraset r i (< x 0x1000000)) (assign i (+ i 1)) (checkbound i 0x1000000)
+(addraset r i (+ x 0x1000001)) (assign i (+ i 1)) (addraset r i (- x 0x1000001)) (assign i (+ i 1)) (addraset r i ( * x 0x1000001)) (assign i (+ i 1)) (addraset r i (and x 0x1000001)) (assign i (+ i 1)) (addraset r i (or x 0x1000001)) (assign i (+ i 1)) (addraset r i (xor x 0x1000001)) (assign i (+ i 1)) (addraset r i (< x 0x1000001)) (assign i (+ i 1)) (checkbound i 0x1000001)
+(addraset r i (+ x -1)) (assign i (+ i 1)) (addraset r i (- x -1)) (assign i (+ i 1)) (addraset r i ( * x -1)) (assign i (+ i 1)) (addraset r i (and x -1)) (assign i (+ i 1)) (addraset r i (or x -1)) (assign i (+ i 1)) (addraset r i (xor x -1)) (assign i (+ i 1)) (addraset r i (< x -1)) (assign i (+ i 1)) (checkbound i -1)
+(addraset r i (+ x -0xFF)) (assign i (+ i 1)) (addraset r i (- x -0xFF)) (assign i (+ i 1)) (addraset r i ( * x -0xFF)) (assign i (+ i 1)) (addraset r i (and x -0xFF)) (assign i (+ i 1)) (addraset r i (or x -0xFF)) (assign i (+ i 1)) (addraset r i (xor x -0xFF)) (assign i (+ i 1)) (addraset r i (< x -0xFF)) (assign i (+ i 1)) (checkbound i -0xFF)
+(addraset r i (+ x -0x100)) (assign i (+ i 1)) (addraset r i (- x -0x100)) (assign i (+ i 1)) (addraset r i ( * x -0x100)) (assign i (+ i 1)) (addraset r i (and x -0x100)) (assign i (+ i 1)) (addraset r i (or x -0x100)) (assign i (+ i 1)) (addraset r i (xor x -0x100)) (assign i (+ i 1)) (addraset r i (< x -0x100)) (assign i (+ i 1)) (checkbound i -0x100)
+(addraset r i (+ x -0x3FC)) (assign i (+ i 1)) (addraset r i (- x -0x3FC)) (assign i (+ i 1)) (addraset r i ( * x -0x3FC)) (assign i (+ i 1)) (addraset r i (and x -0x3FC)) (assign i (+ i 1)) (addraset r i (or x -0x3FC)) (assign i (+ i 1)) (addraset r i (xor x -0x3FC)) (assign i (+ i 1)) (addraset r i (< x -0x3FC)) (assign i (+ i 1)) (checkbound i -0x3FC)
+(addraset r i (+ x -0x3FF)) (assign i (+ i 1)) (addraset r i (- x -0x3FF)) (assign i (+ i 1)) (addraset r i ( * x -0x3FF)) (assign i (+ i 1)) (addraset r i (and x -0x3FF)) (assign i (+ i 1)) (addraset r i (or x -0x3FF)) (assign i (+ i 1)) (addraset r i (xor x -0x3FF)) (assign i (+ i 1)) (addraset r i (< x -0x3FF)) (assign i (+ i 1)) (checkbound i -0x3FF)
+(addraset r i (+ x -0x7FF)) (assign i (+ i 1)) (addraset r i (- x -0x7FF)) (assign i (+ i 1)) (addraset r i ( * x -0x7FF)) (assign i (+ i 1)) (addraset r i (and x -0x7FF)) (assign i (+ i 1)) (addraset r i (or x -0x7FF)) (assign i (+ i 1)) (addraset r i (xor x -0x7FF)) (assign i (+ i 1)) (addraset r i (< x -0x7FF)) (assign i (+ i 1)) (checkbound i -0x7FF)
+(addraset r i (+ x -0x800)) (assign i (+ i 1)) (addraset r i (- x -0x800)) (assign i (+ i 1)) (addraset r i ( * x -0x800)) (assign i (+ i 1)) (addraset r i (and x -0x800)) (assign i (+ i 1)) (addraset r i (or x -0x800)) (assign i (+ i 1)) (addraset r i (xor x -0x800)) (assign i (+ i 1)) (addraset r i (< x -0x800)) (assign i (+ i 1)) (checkbound i -0x800)
+(addraset r i (+ x -0x801)) (assign i (+ i 1)) (addraset r i (- x -0x801)) (assign i (+ i 1)) (addraset r i ( * x -0x801)) (assign i (+ i 1)) (addraset r i (and x -0x801)) (assign i (+ i 1)) (addraset r i (or x -0x801)) (assign i (+ i 1)) (addraset r i (xor x -0x801)) (assign i (+ i 1)) (addraset r i (< x -0x801)) (assign i (+ i 1)) (checkbound i -0x801)
+(addraset r i (+ x -0xFFF)) (assign i (+ i 1)) (addraset r i (- x -0xFFF)) (assign i (+ i 1)) (addraset r i ( * x -0xFFF)) (assign i (+ i 1)) (addraset r i (and x -0xFFF)) (assign i (+ i 1)) (addraset r i (or x -0xFFF)) (assign i (+ i 1)) (addraset r i (xor x -0xFFF)) (assign i (+ i 1)) (addraset r i (< x -0xFFF)) (assign i (+ i 1)) (checkbound i -0xFFF)
+(addraset r i (+ x -0x1000)) (assign i (+ i 1)) (addraset r i (- x -0x1000)) (assign i (+ i 1)) (addraset r i ( * x -0x1000)) (assign i (+ i 1)) (addraset r i (and x -0x1000)) (assign i (+ i 1)) (addraset r i (or x -0x1000)) (assign i (+ i 1)) (addraset r i (xor x -0x1000)) (assign i (+ i 1)) (addraset r i (< x -0x1000)) (assign i (+ i 1)) (checkbound i -0x1000)
+(addraset r i (+ x -0x1001)) (assign i (+ i 1)) (addraset r i (- x -0x1001)) (assign i (+ i 1)) (addraset r i ( * x -0x1001)) (assign i (+ i 1)) (addraset r i (and x -0x1001)) (assign i (+ i 1)) (addraset r i (or x -0x1001)) (assign i (+ i 1)) (addraset r i (xor x -0x1001)) (assign i (+ i 1)) (addraset r i (< x -0x1001)) (assign i (+ i 1)) (checkbound i -0x1001)
+(addraset r i (+ x -0x7FFF)) (assign i (+ i 1)) (addraset r i (- x -0x7FFF)) (assign i (+ i 1)) (addraset r i ( * x -0x7FFF)) (assign i (+ i 1)) (addraset r i (and x -0x7FFF)) (assign i (+ i 1)) (addraset r i (or x -0x7FFF)) (assign i (+ i 1)) (addraset r i (xor x -0x7FFF)) (assign i (+ i 1)) (addraset r i (< x -0x7FFF)) (assign i (+ i 1)) (checkbound i -0x7FFF)
+(addraset r i (+ x -0x8000)) (assign i (+ i 1)) (addraset r i (- x -0x8000)) (assign i (+ i 1)) (addraset r i ( * x -0x8000)) (assign i (+ i 1)) (addraset r i (and x -0x8000)) (assign i (+ i 1)) (addraset r i (or x -0x8000)) (assign i (+ i 1)) (addraset r i (xor x -0x8000)) (assign i (+ i 1)) (addraset r i (< x -0x8000)) (assign i (+ i 1)) (checkbound i -0x8000)
+(addraset r i (+ x -0x8001)) (assign i (+ i 1)) (addraset r i (- x -0x8001)) (assign i (+ i 1)) (addraset r i ( * x -0x8001)) (assign i (+ i 1)) (addraset r i (and x -0x8001)) (assign i (+ i 1)) (addraset r i (or x -0x8001)) (assign i (+ i 1)) (addraset r i (xor x -0x8001)) (assign i (+ i 1)) (addraset r i (< x -0x8001)) (assign i (+ i 1)) (checkbound i -0x8001)
+(addraset r i (+ x -0xFFF000)) (assign i (+ i 1)) (addraset r i (- x -0xFFF000)) (assign i (+ i 1)) (addraset r i ( * x -0xFFF000)) (assign i (+ i 1)) (addraset r i (and x -0xFFF000)) (assign i (+ i 1)) (addraset r i (or x -0xFFF000)) (assign i (+ i 1)) (addraset r i (xor x -0xFFF000)) (assign i (+ i 1)) (addraset r i (< x -0xFFF000)) (assign i (+ i 1)) (checkbound i -0xFFF000)
+(addraset r i (+ x -0xFFFFFF)) (assign i (+ i 1)) (addraset r i (- x -0xFFFFFF)) (assign i (+ i 1)) (addraset r i ( * x -0xFFFFFF)) (assign i (+ i 1)) (addraset r i (and x -0xFFFFFF)) (assign i (+ i 1)) (addraset r i (or x -0xFFFFFF)) (assign i (+ i 1)) (addraset r i (xor x -0xFFFFFF)) (assign i (+ i 1)) (addraset r i (< x -0xFFFFFF)) (assign i (+ i 1)) (checkbound i -0xFFFFFF)
+(addraset r i (+ x -0x1000000)) (assign i (+ i 1)) (addraset r i (- x -0x1000000)) (assign i (+ i 1)) (addraset r i ( * x -0x1000000)) (assign i (+ i 1)) (addraset r i (and x -0x1000000)) (assign i (+ i 1)) (addraset r i (or x -0x1000000)) (assign i (+ i 1)) (addraset r i (xor x -0x1000000)) (assign i (+ i 1)) (addraset r i (< x -0x1000000)) (assign i (+ i 1)) (checkbound i -0x1000000)
+(addraset r i (+ x -0x1000001)) (assign i (+ i 1)) (addraset r i (- x -0x1000001)) (assign i (+ i 1)) (addraset r i ( * x -0x1000001)) (assign i (+ i 1)) (addraset r i (and x -0x1000001)) (assign i (+ i 1)) (addraset r i (or x -0x1000001)) (assign i (+ i 1)) (addraset r i (xor x -0x1000001)) (assign i (+ i 1)) (addraset r i (< x -0x1000001)) (assign i (+ i 1)) (checkbound i -0x1000001)
+))))
--- /dev/null
+#define T TEST
+
+(* T
+files = "mainimmed.c"
+arguments = "-I ${test_source_directory} mainimmed.c"
+* asmgen
+*)
+
+(* Regenerate with cpp -P immediates.cmmpp > immediates.cmm *)
+
+#define F(N) \
+ (addraset r i (+ x N)) (assign i (+ i 1)) \
+ (addraset r i (- x N)) (assign i (+ i 1)) \
+ (addraset r i ( * x N)) (assign i (+ i 1)) \
+ (addraset r i (and x N)) (assign i (+ i 1)) \
+ (addraset r i (or x N)) (assign i (+ i 1)) \
+ (addraset r i (xor x N)) (assign i (+ i 1)) \
+ (addraset r i (< x N)) (assign i (+ i 1)) \
+ (checkbound i N)
+
+(function "testimm" ()
+ (let x (load int "X")
+ (let r "R"
+ (letmut i int 0
+#include "immediates.tbl"
+))))
--- /dev/null
+F(0)
+F(1)
+F(0xFF)
+F(0x100)
+F(0x3FC)
+F(0x3FF)
+F(0x7FF)
+F(0x800)
+F(0x801)
+F(0xFFF)
+F(0x1000)
+F(0x1001)
+F(0x7FFF)
+F(0x8000)
+F(0x8001)
+F(0xFFF000)
+F(0xFFFFFF)
+F(0x1000000)
+F(0x1000001)
+F(-1)
+F(-0xFF)
+F(-0x100)
+F(-0x3FC)
+F(-0x3FF)
+F(-0x7FF)
+F(-0x800)
+F(-0x801)
+F(-0xFFF)
+F(-0x1000)
+F(-0x1001)
+F(-0x7FFF)
+F(-0x8000)
+F(-0x8001)
+F(-0xFFF000)
+F(-0xFFFFFF)
+F(-0x1000000)
+F(-0x1000001)
--- /dev/null
+#include <stdio.h>
+#include <stdlib.h>
+#include <caml/config.h>
+
+#define NUMTESTS 37
+intnat R[NUMTESTS][7];
+intnat X;
+
+extern void call_gen_code(void (*)(void));
+extern void testimm(void);
+
+void caml_ml_array_bound_error(void)
+{
+ fprintf(stderr, "Fatal error: out-of-bound access in array or string\n");
+ exit(2);
+}
+
+/* One round of testing */
+
+#define FMT ARCH_INTNAT_PRINTF_FORMAT
+
+static void check(int i, intnat x, intnat result, intnat expected)
+{
+ if (result != expected) {
+ printf("Test %d, argument %"FMT"d: got %"FMT"d, expected %"FMT"d\n",
+ i, x, result, expected);
+ }
+}
+
+static void test_one(int i, intnat x, intnat y)
+{
+ check(i, x, R[i][0], x + y);
+ check(i, x, R[i][1], x - y);
+ check(i, x, R[i][2], x * y);
+ check(i, x, R[i][3], x & y);
+ check(i, x, R[i][4], x | y);
+ check(i, x, R[i][5], x ^ y);
+ check(i, x, R[i][6], x < y);
+}
+
+static void do_test(intnat x)
+{
+ int i;
+
+ X = x;
+ call_gen_code(testimm);
+ i = 0;
+#define F(N) test_one(i++, x, N);
+#include "immediates.tbl"
+}
+
+/* A simple linear congruential PRNG */
+
+#ifdef ARCH_SIXTYFOUR
+#define RAND_A 6364136223846793005ULL
+#define RAND_C 1442695040888963407ULL
+#else
+#define RAND_A 214013U
+#define RAND_C 2531011U
+#endif
+
+static intnat rnd(void)
+{
+ static uintnat seed = 0;
+ seed = seed * RAND_A + RAND_C;
+ return (intnat) seed;
+}
+
+/* Test harness */
+
+#define NUM_RANDOM_ITERATIONS 1000000
+
+int main(int argc, char **argv)
+{
+ int i;
+ for (i = 0; i < NUM_RANDOM_ITERATIONS; i++) do_test(rnd());
+ return 0;
+}
(intaset (addraref "board" i1) j1 1)
(intaset (addraref "board" i2) j2 2)
(if (app "solve" (+ m 1) int)
- (raise_notrace 0a)
+ (raise_notrace 0)
[])
(intaset (addraref "board" i) j 2)
(intaset (addraref "board" i1) j1 2)
(* TEST
flags = "-g"
ocamlrunparam += ",b=1"
- compare_programs = "false"
*)
(* A test for stack backtraces *)
| Error "c" -> raise (Error "c")
let _ =
- Printexc.record_backtrace true;
ignore (g Sys.argv.(1))
a
b
Fatal error: exception Backtrace.Error("b")
-Raised at Backtrace.f in file "backtrace.ml", line 12, characters 16-32
-Called from Backtrace.f in file "backtrace.ml", line 12, characters 42-53
-Called from Backtrace.f in file "backtrace.ml", line 12, characters 42-53
-Called from Backtrace.f in file "backtrace.ml", line 12, characters 42-53
-Called from Backtrace.f in file "backtrace.ml", line 12, characters 42-53
-Called from Backtrace.f in file "backtrace.ml", line 12, characters 42-53
-Called from Backtrace.g in file "backtrace.ml", line 16, characters 4-11
-Re-raised at Backtrace.g in file "backtrace.ml", line 18, characters 62-71
-Called from Backtrace in file "backtrace.ml", line 23, characters 9-25
+Raised at Backtrace.f in file "backtrace.ml", line 11, characters 16-32
+Called from Backtrace.f in file "backtrace.ml", line 11, characters 42-53
+Called from Backtrace.f in file "backtrace.ml", line 11, characters 42-53
+Called from Backtrace.f in file "backtrace.ml", line 11, characters 42-53
+Called from Backtrace.f in file "backtrace.ml", line 11, characters 42-53
+Called from Backtrace.f in file "backtrace.ml", line 11, characters 42-53
+Called from Backtrace.g in file "backtrace.ml", line 15, characters 4-11
+Re-raised at Backtrace.g in file "backtrace.ml", line 17, characters 62-71
+Called from Backtrace in file "backtrace.ml", line 21, characters 9-25
Fatal error: exception Backtrace.Error("c")
-Raised at Backtrace.g in file "backtrace.ml", line 19, characters 20-37
-Called from Backtrace in file "backtrace.ml", line 23, characters 9-25
+Raised at Backtrace.g in file "backtrace.ml", line 18, characters 20-37
+Called from Backtrace in file "backtrace.ml", line 21, characters 9-25
Fatal error: exception Backtrace.Error("d")
-Raised at Backtrace.f in file "backtrace.ml", line 12, characters 16-32
-Called from Backtrace.f in file "backtrace.ml", line 12, characters 42-53
-Called from Backtrace.f in file "backtrace.ml", line 12, characters 42-53
-Called from Backtrace.f in file "backtrace.ml", line 12, characters 42-53
-Called from Backtrace.f in file "backtrace.ml", line 12, characters 42-53
-Called from Backtrace.f in file "backtrace.ml", line 12, characters 42-53
-Called from Backtrace.g in file "backtrace.ml", line 16, characters 4-11
-Called from Backtrace in file "backtrace.ml", line 23, characters 9-25
+Raised at Backtrace.f in file "backtrace.ml", line 11, characters 16-32
+Called from Backtrace.f in file "backtrace.ml", line 11, characters 42-53
+Called from Backtrace.f in file "backtrace.ml", line 11, characters 42-53
+Called from Backtrace.f in file "backtrace.ml", line 11, characters 42-53
+Called from Backtrace.f in file "backtrace.ml", line 11, characters 42-53
+Called from Backtrace.f in file "backtrace.ml", line 11, characters 42-53
+Called from Backtrace.g in file "backtrace.ml", line 15, characters 4-11
+Called from Backtrace in file "backtrace.ml", line 21, characters 9-25
Fatal error: exception Invalid_argument("index out of bounds")
-Raised by primitive operation at Backtrace in file "backtrace.ml", line 23, characters 12-24
+Raised by primitive operation at Backtrace in file "backtrace.ml", line 21, characters 12-24
(* TEST
flags = "-g"
ocamlrunparam += ",b=1"
- compare_programs = "false"
*)
(* A test for stack backtraces *)
Printexc.print_backtrace stdout
let _ =
- Printexc.record_backtrace true;
run test_Error [| "a" |];
run test_Error [| "b" |];
run test_Error [| "c" |];
No exception
b
Uncaught exception Backtrace2.Error("b")
-Raised at Backtrace2.test_Error.f in file "backtrace2.ml", line 13, characters 18-34
-Called from Backtrace2.test_Error.f in file "backtrace2.ml", line 13, characters 44-55
-Called from Backtrace2.test_Error.f in file "backtrace2.ml", line 13, characters 44-55
-Called from Backtrace2.test_Error.f in file "backtrace2.ml", line 13, characters 44-55
-Called from Backtrace2.test_Error.f in file "backtrace2.ml", line 13, characters 44-55
-Called from Backtrace2.test_Error.f in file "backtrace2.ml", line 13, characters 44-55
-Called from Backtrace2.test_Error in file "backtrace2.ml", line 18, characters 4-11
-Re-raised at Backtrace2.test_Error in file "backtrace2.ml", line 20, characters 62-71
-Called from Backtrace2.run in file "backtrace2.ml", line 63, characters 11-23
+Raised at Backtrace2.test_Error.f in file "backtrace2.ml", line 12, characters 18-34
+Called from Backtrace2.test_Error.f in file "backtrace2.ml", line 12, characters 44-55
+Called from Backtrace2.test_Error.f in file "backtrace2.ml", line 12, characters 44-55
+Called from Backtrace2.test_Error.f in file "backtrace2.ml", line 12, characters 44-55
+Called from Backtrace2.test_Error.f in file "backtrace2.ml", line 12, characters 44-55
+Called from Backtrace2.test_Error.f in file "backtrace2.ml", line 12, characters 44-55
+Called from Backtrace2.test_Error in file "backtrace2.ml", line 17, characters 4-11
+Re-raised at Backtrace2.test_Error in file "backtrace2.ml", line 19, characters 62-71
+Called from Backtrace2.run in file "backtrace2.ml", line 62, characters 11-23
Uncaught exception Backtrace2.Error("c")
-Raised at Backtrace2.test_Error in file "backtrace2.ml", line 21, characters 20-37
-Called from Backtrace2.run in file "backtrace2.ml", line 63, characters 11-23
+Raised at Backtrace2.test_Error in file "backtrace2.ml", line 20, characters 20-37
+Called from Backtrace2.run in file "backtrace2.ml", line 62, characters 11-23
Uncaught exception Backtrace2.Error("d")
-Raised at Backtrace2.test_Error.f in file "backtrace2.ml", line 13, characters 18-34
-Called from Backtrace2.test_Error.f in file "backtrace2.ml", line 13, characters 44-55
-Called from Backtrace2.test_Error.f in file "backtrace2.ml", line 13, characters 44-55
-Called from Backtrace2.test_Error.f in file "backtrace2.ml", line 13, characters 44-55
-Called from Backtrace2.test_Error.f in file "backtrace2.ml", line 13, characters 44-55
-Called from Backtrace2.test_Error.f in file "backtrace2.ml", line 13, characters 44-55
-Called from Backtrace2.test_Error in file "backtrace2.ml", line 18, characters 4-11
-Called from Backtrace2.run in file "backtrace2.ml", line 63, characters 11-23
+Raised at Backtrace2.test_Error.f in file "backtrace2.ml", line 12, characters 18-34
+Called from Backtrace2.test_Error.f in file "backtrace2.ml", line 12, characters 44-55
+Called from Backtrace2.test_Error.f in file "backtrace2.ml", line 12, characters 44-55
+Called from Backtrace2.test_Error.f in file "backtrace2.ml", line 12, characters 44-55
+Called from Backtrace2.test_Error.f in file "backtrace2.ml", line 12, characters 44-55
+Called from Backtrace2.test_Error.f in file "backtrace2.ml", line 12, characters 44-55
+Called from Backtrace2.test_Error in file "backtrace2.ml", line 17, characters 4-11
+Called from Backtrace2.run in file "backtrace2.ml", line 62, characters 11-23
e
Uncaught exception Backtrace2.Error("e")
-Raised at Backtrace2.test_Error in file "backtrace2.ml", line 27, characters 50-59
-Called from Backtrace2.run in file "backtrace2.ml", line 63, characters 11-23
+Raised at Backtrace2.test_Error in file "backtrace2.ml", line 26, characters 50-59
+Called from Backtrace2.run in file "backtrace2.ml", line 62, characters 11-23
f
Uncaught exception Backtrace2.Error("f")
-Raised at Backtrace2.test_Error in file "backtrace2.ml", line 33, characters 62-71
-Called from Backtrace2.run in file "backtrace2.ml", line 63, characters 11-23
+Raised at Backtrace2.test_Error in file "backtrace2.ml", line 32, characters 62-71
+Called from Backtrace2.run in file "backtrace2.ml", line 62, characters 11-23
Uncaught exception Invalid_argument("index out of bounds")
-Raised by primitive operation at Backtrace2.run in file "backtrace2.ml", line 63, characters 14-22
+Raised by primitive operation at Backtrace2.run in file "backtrace2.ml", line 62, characters 14-22
test_Not_found
Uncaught exception Not_found
-Raised at Stdlib__hashtbl.find in file "hashtbl.ml", line 537, characters 13-28
-Called from Backtrace2.test_Not_found in file "backtrace2.ml", line 44, characters 9-42
-Re-raised at Backtrace2.test_Not_found in file "backtrace2.ml", line 44, characters 61-70
-Called from Backtrace2.run in file "backtrace2.ml", line 63, characters 11-23
+Raised at Stdlib__hashtbl.find in file "hashtbl.ml", line 539, characters 13-28
+Called from Backtrace2.test_Not_found in file "backtrace2.ml", line 43, characters 9-42
+Re-raised at Backtrace2.test_Not_found in file "backtrace2.ml", line 43, characters 61-70
+Called from Backtrace2.run in file "backtrace2.ml", line 62, characters 11-23
Uncaught exception Not_found
-Raised at Backtrace2.test_lazy.aux in file "backtrace2.ml", line 48, characters 18-33
-Called from Backtrace2.test_lazy.aux in file "backtrace2.ml", line 48, characters 43-52
-Called from Backtrace2.test_lazy.aux in file "backtrace2.ml", line 48, characters 43-52
-Called from Backtrace2.test_lazy.aux in file "backtrace2.ml", line 48, characters 43-52
-Called from Backtrace2.test_lazy.aux in file "backtrace2.ml", line 48, characters 43-52
-Called from Backtrace2.test_lazy.aux in file "backtrace2.ml", line 48, characters 43-52
+Raised at Backtrace2.test_lazy.aux in file "backtrace2.ml", line 47, characters 18-33
+Called from Backtrace2.test_lazy.aux in file "backtrace2.ml", line 47, characters 43-52
+Called from Backtrace2.test_lazy.aux in file "backtrace2.ml", line 47, characters 43-52
+Called from Backtrace2.test_lazy.aux in file "backtrace2.ml", line 47, characters 43-52
+Called from Backtrace2.test_lazy.aux in file "backtrace2.ml", line 47, characters 43-52
+Called from Backtrace2.test_lazy.aux in file "backtrace2.ml", line 47, characters 43-52
Called from CamlinternalLazy.force_lazy_block in file "camlinternalLazy.ml", line 31, characters 17-27
Re-raised at CamlinternalLazy.force_lazy_block in file "camlinternalLazy.ml", line 36, characters 4-11
-Called from Backtrace2.run in file "backtrace2.ml", line 63, characters 11-23
+Called from Backtrace2.run in file "backtrace2.ml", line 62, characters 11-23
Uncaught exception Not_found
-Raised at Stdlib__hashtbl.find in file "hashtbl.ml", line 537, characters 13-28
-Called from Backtrace2.test_lazy.exception_raised_internally in file "backtrace2.ml", line 51, characters 8-41
+Raised at Stdlib__hashtbl.find in file "hashtbl.ml", line 539, characters 13-28
+Called from Backtrace2.test_lazy.exception_raised_internally in file "backtrace2.ml", line 50, characters 8-41
Re-raised at CamlinternalLazy.force_lazy_block.(fun) in file "camlinternalLazy.ml", line 35, characters 56-63
Called from CamlinternalLazy.force_lazy_block in file "camlinternalLazy.ml", line 31, characters 17-27
Re-raised at CamlinternalLazy.force_lazy_block in file "camlinternalLazy.ml", line 36, characters 4-11
-Called from Backtrace2.run in file "backtrace2.ml", line 63, characters 11-23
+Called from Backtrace2.run in file "backtrace2.ml", line 62, characters 11-23
(* TEST
flags = "-g"
ocamlrunparam += ",b=1"
- compare_programs = "false"
*)
(* A test for stack backtraces *)
Printexc.print_backtrace stdout
let _ =
- Printexc.record_backtrace true;
run [| "a" |];
run [| "b" |];
run [| "c" |];
No exception
b
Uncaught exception Backtrace3.Error("b")
-Raised at Backtrace3.f in file "backtrace3.ml", line 12, characters 16-32
-Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
-Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
-Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
-Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
-Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
-Called from Backtrace3.g in file "backtrace3.ml", line 16, characters 4-11
-Re-raised at Backtrace3.g in file "backtrace3.ml", line 25, characters 41-50
-Called from Backtrace3.run in file "backtrace3.ml", line 50, characters 11-23
+Raised at Backtrace3.f in file "backtrace3.ml", line 11, characters 16-32
+Called from Backtrace3.f in file "backtrace3.ml", line 11, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 11, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 11, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 11, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 11, characters 42-53
+Called from Backtrace3.g in file "backtrace3.ml", line 15, characters 4-11
+Re-raised at Backtrace3.g in file "backtrace3.ml", line 24, characters 41-50
+Called from Backtrace3.run in file "backtrace3.ml", line 49, characters 11-23
c
Uncaught exception Backtrace3.Error("c")
-Raised at Backtrace3.g in file "backtrace3.ml", line 29, characters 41-58
-Called from Backtrace3.run in file "backtrace3.ml", line 50, characters 11-23
+Raised at Backtrace3.g in file "backtrace3.ml", line 28, characters 41-58
+Called from Backtrace3.run in file "backtrace3.ml", line 49, characters 11-23
d
Uncaught exception Backtrace3.Error("d")
-Raised at Backtrace3.f in file "backtrace3.ml", line 12, characters 16-32
-Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
-Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
-Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
-Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
-Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
-Called from Backtrace3.g in file "backtrace3.ml", line 16, characters 4-11
-Re-raised at Backtrace3.g in file "backtrace3.ml", line 32, characters 41-50
-Called from Backtrace3.run in file "backtrace3.ml", line 50, characters 11-23
+Raised at Backtrace3.f in file "backtrace3.ml", line 11, characters 16-32
+Called from Backtrace3.f in file "backtrace3.ml", line 11, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 11, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 11, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 11, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 11, characters 42-53
+Called from Backtrace3.g in file "backtrace3.ml", line 15, characters 4-11
+Re-raised at Backtrace3.g in file "backtrace3.ml", line 31, characters 41-50
+Called from Backtrace3.run in file "backtrace3.ml", line 49, characters 11-23
e
Uncaught exception Backtrace3.Error("e")
-Raised at Backtrace3.f in file "backtrace3.ml", line 12, characters 16-32
-Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
-Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
-Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
-Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
-Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
-Called from Backtrace3.g in file "backtrace3.ml", line 16, characters 4-11
-Re-raised at Backtrace3.g in file "backtrace3.ml", line 35, characters 41-51
-Called from Backtrace3.run in file "backtrace3.ml", line 50, characters 11-23
+Raised at Backtrace3.f in file "backtrace3.ml", line 11, characters 16-32
+Called from Backtrace3.f in file "backtrace3.ml", line 11, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 11, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 11, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 11, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 11, characters 42-53
+Called from Backtrace3.g in file "backtrace3.ml", line 15, characters 4-11
+Re-raised at Backtrace3.g in file "backtrace3.ml", line 34, characters 41-51
+Called from Backtrace3.run in file "backtrace3.ml", line 49, characters 11-23
f
Uncaught exception Backtrace3.Error("f")
-Raised at Backtrace3.f in file "backtrace3.ml", line 12, characters 16-32
-Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
-Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
-Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
-Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
-Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
-Called from Backtrace3.g in file "backtrace3.ml", line 16, characters 4-11
-Re-raised at Backtrace3.g in file "backtrace3.ml", line 40, characters 45-54
-Called from Backtrace3.run in file "backtrace3.ml", line 50, characters 11-23
+Raised at Backtrace3.f in file "backtrace3.ml", line 11, characters 16-32
+Called from Backtrace3.f in file "backtrace3.ml", line 11, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 11, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 11, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 11, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 11, characters 42-53
+Called from Backtrace3.g in file "backtrace3.ml", line 15, characters 4-11
+Re-raised at Backtrace3.g in file "backtrace3.ml", line 39, characters 45-54
+Called from Backtrace3.run in file "backtrace3.ml", line 49, characters 11-23
g
Uncaught exception Backtrace3.Error("g")
-Raised at Backtrace3.f in file "backtrace3.ml", line 12, characters 16-32
-Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
-Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
-Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
-Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
-Called from Backtrace3.f in file "backtrace3.ml", line 12, characters 42-53
-Called from Backtrace3.g in file "backtrace3.ml", line 16, characters 4-11
-Re-raised at Backtrace3.g in file "backtrace3.ml", line 43, characters 45-55
-Called from Backtrace3.run in file "backtrace3.ml", line 50, characters 11-23
+Raised at Backtrace3.f in file "backtrace3.ml", line 11, characters 16-32
+Called from Backtrace3.f in file "backtrace3.ml", line 11, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 11, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 11, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 11, characters 42-53
+Called from Backtrace3.f in file "backtrace3.ml", line 11, characters 42-53
+Called from Backtrace3.g in file "backtrace3.ml", line 15, characters 4-11
+Re-raised at Backtrace3.g in file "backtrace3.ml", line 42, characters 45-55
+Called from Backtrace3.run in file "backtrace3.ml", line 49, characters 11-23
Uncaught exception Backtrace3.Error("h")
-Raised at Backtrace3.g in file "backtrace3.ml", line 46, characters 10-17
-Called from Backtrace3.run in file "backtrace3.ml", line 50, characters 11-23
+Raised at Backtrace3.g in file "backtrace3.ml", line 45, characters 10-17
+Called from Backtrace3.run in file "backtrace3.ml", line 49, characters 11-23
Uncaught exception Invalid_argument("index out of bounds")
-Raised by primitive operation at Backtrace3.run in file "backtrace3.ml", line 50, characters 14-22
+Raised by primitive operation at Backtrace3.run in file "backtrace3.ml", line 49, characters 14-22
(* TEST
flags = "-g"
ocamlrunparam += ",b=1"
- compare_programs = "false"
*)
(* A test for stack backtraces *)
trace
let _ =
- Printexc.record_backtrace true;
run [| "a" |];
run [| "b" |];
run [| "c" |];
No exception
b
Uncaught exception Backtrace_deprecated.Error("b")
-Raised at Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 15, characters 16-32
-Called from Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 15, characters 42-53
-Called from Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 15, characters 42-53
-Called from Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 15, characters 42-53
-Called from Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 15, characters 42-53
-Called from Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 15, characters 42-53
-Called from Backtrace_deprecated.g in file "backtrace_deprecated.ml", line 19, characters 4-11
-Re-raised at Backtrace_deprecated.g in file "backtrace_deprecated.ml", line 21, characters 62-71
-Called from Backtrace_deprecated.run in file "backtrace_deprecated.ml", line 26, characters 11-23
+Raised at Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 14, characters 16-32
+Called from Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 14, characters 42-53
+Called from Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 14, characters 42-53
+Called from Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 14, characters 42-53
+Called from Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 14, characters 42-53
+Called from Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 14, characters 42-53
+Called from Backtrace_deprecated.g in file "backtrace_deprecated.ml", line 18, characters 4-11
+Re-raised at Backtrace_deprecated.g in file "backtrace_deprecated.ml", line 20, characters 62-71
+Called from Backtrace_deprecated.run in file "backtrace_deprecated.ml", line 25, characters 11-23
Uncaught exception Backtrace_deprecated.Error("c")
-Raised at Backtrace_deprecated.g in file "backtrace_deprecated.ml", line 22, characters 20-37
-Called from Backtrace_deprecated.run in file "backtrace_deprecated.ml", line 26, characters 11-23
+Raised at Backtrace_deprecated.g in file "backtrace_deprecated.ml", line 21, characters 20-37
+Called from Backtrace_deprecated.run in file "backtrace_deprecated.ml", line 25, characters 11-23
Uncaught exception Backtrace_deprecated.Error("d")
-Raised at Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 15, characters 16-32
-Called from Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 15, characters 42-53
-Called from Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 15, characters 42-53
-Called from Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 15, characters 42-53
-Called from Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 15, characters 42-53
-Called from Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 15, characters 42-53
-Called from Backtrace_deprecated.g in file "backtrace_deprecated.ml", line 19, characters 4-11
-Called from Backtrace_deprecated.run in file "backtrace_deprecated.ml", line 26, characters 11-23
+Raised at Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 14, characters 16-32
+Called from Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 14, characters 42-53
+Called from Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 14, characters 42-53
+Called from Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 14, characters 42-53
+Called from Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 14, characters 42-53
+Called from Backtrace_deprecated.f in file "backtrace_deprecated.ml", line 14, characters 42-53
+Called from Backtrace_deprecated.g in file "backtrace_deprecated.ml", line 18, characters 4-11
+Called from Backtrace_deprecated.run in file "backtrace_deprecated.ml", line 25, characters 11-23
Uncaught exception Invalid_argument("index out of bounds")
-Raised by primitive operation at Backtrace_deprecated.run in file "backtrace_deprecated.ml", line 26, characters 14-22
+Raised by primitive operation at Backtrace_deprecated.run in file "backtrace_deprecated.ml", line 25, characters 14-22
(* TEST
flags = "-g"
ocamlrunparam += ",b=1"
- compare_programs = "false"
*)
exception Exn
Printf.printf "---------------------------\n%!"
let _ =
- Printexc.record_backtrace true;
run without_reraise;
run with_reraise;
run trickier
exception Backtrace_or_exception.Exn
-Raised at Backtrace_or_exception.without_reraise in file "backtrace_or_exception.ml", line 20, characters 4-13
-Called from Backtrace_or_exception.run in file "backtrace_or_exception.ml", line 40, characters 6-10
+Raised at Backtrace_or_exception.without_reraise in file "backtrace_or_exception.ml", line 19, characters 4-13
+Called from Backtrace_or_exception.run in file "backtrace_or_exception.ml", line 39, characters 6-10
---------------------------
exception Backtrace_or_exception.Exn
-Raised at Backtrace_or_exception.return_exn in file "backtrace_or_exception.ml", line 11, characters 4-13
-Called from Backtrace_or_exception.with_reraise in file "backtrace_or_exception.ml", line 24, characters 8-44
-Re-raised at Backtrace_or_exception.with_reraise in file "backtrace_or_exception.ml", line 27, characters 4-13
-Called from Backtrace_or_exception.run in file "backtrace_or_exception.ml", line 40, characters 6-10
+Raised at Backtrace_or_exception.return_exn in file "backtrace_or_exception.ml", line 10, characters 4-13
+Called from Backtrace_or_exception.with_reraise in file "backtrace_or_exception.ml", line 23, characters 8-44
+Re-raised at Backtrace_or_exception.with_reraise in file "backtrace_or_exception.ml", line 26, characters 4-13
+Called from Backtrace_or_exception.run in file "backtrace_or_exception.ml", line 39, characters 6-10
---------------------------
exception Backtrace_or_exception.Exn
-Raised at Backtrace_or_exception.trickier in file "backtrace_or_exception.ml", line 36, characters 6-15
-Called from Backtrace_or_exception.run in file "backtrace_or_exception.ml", line 40, characters 6-10
+Raised at Backtrace_or_exception.trickier in file "backtrace_or_exception.ml", line 35, characters 6-15
+Called from Backtrace_or_exception.run in file "backtrace_or_exception.ml", line 39, characters 6-10
---------------------------
(* TEST
flags = "-g"
ocamlrunparam += ",b=1"
- compare_programs = "false"
*)
(* A test for stack backtraces *)
| Some line -> print_endline line)
let _ =
- Printexc.record_backtrace true;
run [| "a" |];
run [| "b" |];
run [| "c" |];
No exception
b
Uncaught exception Backtrace_slots.Error("b")
-Raised at Backtrace_slots.f in file "backtrace_slots.ml", line 41, characters 16-32
-Called from Backtrace_slots.f in file "backtrace_slots.ml", line 41, characters 42-53
-Called from Backtrace_slots.f in file "backtrace_slots.ml", line 41, characters 42-53
-Called from Backtrace_slots.f in file "backtrace_slots.ml", line 41, characters 42-53
-Called from Backtrace_slots.f in file "backtrace_slots.ml", line 41, characters 42-53
-Called from Backtrace_slots.f in file "backtrace_slots.ml", line 41, characters 42-53
-Called from Backtrace_slots.g in file "backtrace_slots.ml", line 45, characters 4-11
-Re-raised at Backtrace_slots.g in file "backtrace_slots.ml", line 47, characters 62-71
-Called from Backtrace_slots.run in file "backtrace_slots.ml", line 52, characters 11-23
+Raised at Backtrace_slots.f in file "backtrace_slots.ml", line 40, characters 16-32
+Called from Backtrace_slots.f in file "backtrace_slots.ml", line 40, characters 42-53
+Called from Backtrace_slots.f in file "backtrace_slots.ml", line 40, characters 42-53
+Called from Backtrace_slots.f in file "backtrace_slots.ml", line 40, characters 42-53
+Called from Backtrace_slots.f in file "backtrace_slots.ml", line 40, characters 42-53
+Called from Backtrace_slots.f in file "backtrace_slots.ml", line 40, characters 42-53
+Called from Backtrace_slots.g in file "backtrace_slots.ml", line 44, characters 4-11
+Re-raised at Backtrace_slots.g in file "backtrace_slots.ml", line 46, characters 62-71
+Called from Backtrace_slots.run in file "backtrace_slots.ml", line 51, characters 11-23
Uncaught exception Backtrace_slots.Error("c")
-Raised at Backtrace_slots.g in file "backtrace_slots.ml", line 48, characters 20-37
-Called from Backtrace_slots.run in file "backtrace_slots.ml", line 52, characters 11-23
+Raised at Backtrace_slots.g in file "backtrace_slots.ml", line 47, characters 20-37
+Called from Backtrace_slots.run in file "backtrace_slots.ml", line 51, characters 11-23
Uncaught exception Backtrace_slots.Error("d")
-Raised at Backtrace_slots.f in file "backtrace_slots.ml", line 41, characters 16-32
-Called from Backtrace_slots.f in file "backtrace_slots.ml", line 41, characters 42-53
-Called from Backtrace_slots.f in file "backtrace_slots.ml", line 41, characters 42-53
-Called from Backtrace_slots.f in file "backtrace_slots.ml", line 41, characters 42-53
-Called from Backtrace_slots.f in file "backtrace_slots.ml", line 41, characters 42-53
-Called from Backtrace_slots.f in file "backtrace_slots.ml", line 41, characters 42-53
-Called from Backtrace_slots.g in file "backtrace_slots.ml", line 45, characters 4-11
-Called from Backtrace_slots.run in file "backtrace_slots.ml", line 52, characters 11-23
+Raised at Backtrace_slots.f in file "backtrace_slots.ml", line 40, characters 16-32
+Called from Backtrace_slots.f in file "backtrace_slots.ml", line 40, characters 42-53
+Called from Backtrace_slots.f in file "backtrace_slots.ml", line 40, characters 42-53
+Called from Backtrace_slots.f in file "backtrace_slots.ml", line 40, characters 42-53
+Called from Backtrace_slots.f in file "backtrace_slots.ml", line 40, characters 42-53
+Called from Backtrace_slots.f in file "backtrace_slots.ml", line 40, characters 42-53
+Called from Backtrace_slots.g in file "backtrace_slots.ml", line 44, characters 4-11
+Called from Backtrace_slots.run in file "backtrace_slots.ml", line 51, characters 11-23
Uncaught exception Invalid_argument("index out of bounds")
-Raised by primitive operation at Backtrace_slots.run in file "backtrace_slots.ml", line 52, characters 14-22
+Raised by primitive operation at Backtrace_slots.run in file "backtrace_slots.ml", line 51, characters 14-22
(* TEST
flags = "-g -inline 0"
ocamlrunparam += ",b=1"
- compare_programs = "false"
* native
*)
-let () = Printexc.record_backtrace true
-
let finaliser _ = try raise Exit with _ -> ()
let create () =
flags = "-g"
* hassysthreads
include systhreads
- compare_programs = "false"
** no-flambda
*** native
*** bytecode
main thread:
-Raised by primitive operation at Callstack.f0 in file "callstack.ml", line 12, characters 38-66
-Called from Callstack.f1 in file "callstack.ml", line 13, characters 27-32
-Called from Callstack.f2 in file "callstack.ml", line 14, characters 27-32
-Called from Callstack.f3 in file "callstack.ml", line 15, characters 27-32
-Called from Callstack in file "callstack.ml", line 18, characters 9-14
+Raised by primitive operation at Callstack.f0 in file "callstack.ml", line 11, characters 38-66
+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 Callstack in file "callstack.ml", line 17, characters 9-14
from finalizer:
-Raised by primitive operation at Callstack.f0 in file "callstack.ml", line 12, characters 38-66
-Called from Callstack in file "callstack.ml", line 23, characters 2-18
+Raised by primitive operation at Callstack.f0 in file "callstack.ml", line 11, characters 38-66
+Called from Callstack in file "callstack.ml", line 22, characters 2-18
new thread:
-Raised by primitive operation at Callstack.f0 in file "callstack.ml", line 12, characters 38-66
-Called from Callstack.f1 in file "callstack.ml", line 13, characters 27-32
-Called from Callstack.f2 in file "callstack.ml", line 14, characters 27-32
-Called from Callstack.f3 in file "callstack.ml", line 15, characters 27-32
-Called from Thread.create.(fun) in file "thread.ml", line 39, characters 8-14
+Raised by primitive operation at Callstack.f0 in file "callstack.ml", line 11, characters 38-66
+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
(* TEST
flags = "-g"
- compare_programs = "false" *)
+*)
let f n b =
let arr = Array.make n 42 in
#!/bin/sh
-grep -oE '[a-zA-Z_]+\.ml(:[0-9]+)?|(line|characters) [0-9-]+'
+# This location filter is erasing information from the backtrace
+# to be robust to different inlining choices made by different compiler settings.
+# It checks that the expected locations occur (in the expected order).
+sed -e "s/^.*in file/File/" -e 's/ (inlined)//' | grep ^File
ocamlrunparam += ",b=1"
* bytecode
* native
- compare_programs = "false"
* native
ocamlopt_flags = "-O3"
compiler_directory_suffix = ".O3"
- compare_programs = "false"
*)
(* A test for inlined stack backtraces *)
if h x = () then ()
let () =
- Printexc.record_backtrace true;
i ()
-inline_test.ml
-line 16
-characters 2-24
-inline_test.ml
-line 19
-characters 2-5
-inline_test.ml
-line 22
-characters 12-17
-inline_test.ml
-line 25
-characters 5-8
-inline_test.ml
-line 29
-characters 2-6
+File "inline_test.ml", line 14, characters 2-24
+File "inline_test.ml", line 17, characters 2-5
+File "inline_test.ml", line 20, characters 12-17
+File "inline_test.ml", line 23, characters 5-8
+File "inline_test.ml", line 26, characters 2-6
ocamlrunparam += ",b=1"
* bytecode
* native
- compare_programs = "false"
* native
ocamlopt_flags = "-O3"
compiler_directory_suffix = ".O3"
- compare_programs = "false"
*)
(* A test for inlined stack backtraces *)
let () =
let open Printexc in
- record_backtrace true;
try i ()
with _ ->
let trace = get_raw_backtrace () in
| Some {filename; line_number; _} ->
filename ^ ":" ^ Int.to_string line_number
in
- Printf.printf "- %s%s%s\n"
+ Printf.printf "File %s%s%s\n"
location
- (if is_inline then " inlined" else "")
+ (if is_inline then " (inlined)" else "")
(if is_raise then ", raise" else "")
in
let rec print_slots = function
-inline_traversal_test.ml:16
-inline_traversal_test.ml:19
-inline_traversal_test.ml:22
-inline_traversal_test.ml:25
-inline_traversal_test.ml:30
+File inline_traversal_test.ml:14, raise
+File inline_traversal_test.ml:17
+File inline_traversal_test.ml:20
+File inline_traversal_test.ml:23
+File inline_traversal_test.ml:27
--- /dev/null
+(* TEST
+ flags = "-g"
+ * native
+*)
+
+
+let l1 : unit lazy_t = lazy (raise Not_found)
+
+let test1 () =
+ let () = Lazy.force l1 in ()
+
+let l2 : unit lazy_t = lazy (raise Not_found)
+
+let test2 () =
+ let (lazy ()) = l2 in ()
+
+let run test =
+ try
+ test ();
+ with exn ->
+ Printf.printf "Uncaught exception %s\n" (Printexc.to_string exn);
+ Printexc.print_backtrace stdout
+
+let () =
+ Printexc.record_backtrace true;
+ run test1;
+ run test2
--- /dev/null
+Uncaught exception Not_found
+Raised at Lazy.l1 in file "lazy.ml", line 7, characters 28-45
+Called from CamlinternalLazy.force_lazy_block in file "camlinternalLazy.ml", line 31, characters 17-27
+Re-raised at CamlinternalLazy.force_lazy_block in file "camlinternalLazy.ml", line 36, characters 4-11
+Called from Lazy.test1 in file "lazy.ml", line 10, characters 11-24
+Called from Lazy.run in file "lazy.ml", line 19, characters 4-11
+Uncaught exception Not_found
+Raised at Lazy.l2 in file "lazy.ml", line 12, characters 28-45
+Called from CamlinternalLazy.force_lazy_block in file "camlinternalLazy.ml", line 31, characters 17-27
+Re-raised at CamlinternalLazy.force_lazy_block in file "camlinternalLazy.ml", line 36, characters 4-11
+Called from Lazy.test2 in file "lazy.ml", line 15, characters 6-15
+Called from Lazy.run in file "lazy.ml", line 19, characters 4-11
(* TEST
flags = "-g"
- compare_programs = "false" *)
+*)
let[@inline never] id x = Sys.opaque_identity x
(* TEST
flags = "-g"
- compare_programs = "false"
*)
-Raised at Names.bang in file "names.ml", line 9, characters 29-39
-Called from Names.inline_object.object#othermeth in file "names.ml", line 97, characters 6-10
-Called from Names.inline_object.object#meth in file "names.ml", line 95, characters 6-26
-Called from Names.klass2#othermeth.(fun) in file "names.ml", line 89, characters 18-22
-Called from Names.klass2#othermeth in file "names.ml", line 89, characters 4-30
-Called from Names.klass#meth in file "names.ml", line 85, characters 4-27
-Called from Names.(+@+) in file "names.ml", line 80, characters 31-35
-Called from Names.Rec2.fn in file "names.ml", line 77, characters 28-32
-Called from Names.Rec1.fn in file "names.ml", line 72, characters 28-34
-Called from Names.Functor.fn in file "names.ml", line 64, characters 28-32
-Called from Names.local_module.N.foo in file "names.ml", line 58, characters 6-10
-Called from Names.local_module.N in file "names.ml", line 59, characters 38-49
-Called from Names.local_no_arg.inner in file "names.ml", line 48, characters 16-20
-Called from Names.local_no_arg.(fun) in file "names.ml", line 49, characters 26-38
-Called from Names.double_local.inner1.inner2 in file "names.ml", line 43, characters 20-24
-Called from Names.double_local.inner1 in file "names.ml", line 44, characters 4-18
-Called from Names.double_local in file "names.ml", line 45, characters 2-16
-Called from Names.local.inner in file "names.ml", line 38, characters 32-36
-Called from Names.local in file "names.ml", line 39, characters 2-15
-Called from Names.double_anon.(fun) in file "names.ml", line 33, characters 6-10
-Called from Names.anon.(fun) in file "names.ml", line 27, characters 25-29
-Called from Names.Mod1.Nested.apply in file "names.ml", line 22, characters 33-37
-Called from Names.fn_poly in file "names.ml", line 18, characters 2-5
-Called from Names.fn_function in file "names.ml", line 15, characters 9-13
-Called from Names.fn_multi in file "names.ml", line 12, characters 36-40
-Called from Names in file "names.ml", line 104, characters 4-445
+Raised at Names.bang in file "names.ml", line 8, characters 29-39
+Called from Names.inline_object.object#othermeth in file "names.ml", line 96, characters 6-10
+Called from Names.inline_object.object#meth in file "names.ml", line 94, characters 6-26
+Called from Names.klass2#othermeth.(fun) in file "names.ml", line 88, characters 18-22
+Called from Names.klass2#othermeth in file "names.ml", line 88, characters 4-30
+Called from Names.klass#meth in file "names.ml", line 84, characters 4-27
+Called from Names.(+@+) in file "names.ml", line 79, characters 31-35
+Called from Names.Rec2.fn in file "names.ml", line 76, characters 28-32
+Called from Names.Rec1.fn in file "names.ml", line 71, characters 28-34
+Called from Names.Functor.fn in file "names.ml", line 63, characters 28-32
+Called from Names.local_module.N.foo in file "names.ml", line 57, characters 6-10
+Called from Names.local_module.N in file "names.ml", line 58, characters 38-49
+Called from Names.local_no_arg.inner in file "names.ml", line 47, characters 16-20
+Called from Names.local_no_arg.(fun) in file "names.ml", line 48, characters 26-38
+Called from Names.double_local.inner1.inner2 in file "names.ml", line 42, characters 20-24
+Called from Names.double_local.inner1 in file "names.ml", line 43, characters 4-18
+Called from Names.double_local in file "names.ml", line 44, characters 2-16
+Called from Names.local.inner in file "names.ml", line 37, characters 32-36
+Called from Names.local in file "names.ml", line 38, characters 2-15
+Called from Names.double_anon.(fun) in file "names.ml", line 32, characters 6-10
+Called from Names.anon.(fun) in file "names.ml", line 26, characters 25-29
+Called from Names.Mod1.Nested.apply in file "names.ml", line 21, characters 33-37
+Called from Names.fn_poly in file "names.ml", line 17, characters 2-5
+Called from Names.fn_function in file "names.ml", line 14, characters 9-13
+Called from Names.fn_multi in file "names.ml", line 11, characters 36-40
+Called from Names in file "names.ml", line 103, characters 4-445
--- /dev/null
+Fatal error: exception Stdlib.Exit
+Raised by primitive operation at Stdlib.open_in_gen in file "stdlib.ml", line 399, characters 28-54
+Called from Pr2195 in file "pr2195.ml", line 24, characters 6-19
+Re-raised at Pr2195 in file "pr2195.ml", line 29, characters 4-41
--- /dev/null
+Fatal error: exception Stdlib.Exit
+Raised by primitive operation at unknown location
+Called from unknown location
+(Cannot print locations:
+ bytecode executable program file cannot be opened;
+ -- too many open files. Try running with OCAMLRUNPARAM=b=2)
--- /dev/null
+(* TEST
+ flags += "-g"
+ exit_status = "2"
+ * bytecode
+ ocamlrunparam += ",b=0"
+ reference = "${test_source_directory}/pr2195-nolocs.byte.reference"
+ * bytecode
+ ocamlrunparam += ",b=1"
+ reference = "${test_source_directory}/pr2195-nolocs.byte.reference"
+ * bytecode
+ ocamlrunparam += ",b=2"
+ reference = "${test_source_directory}/pr2195-locs.byte.reference"
+ * native
+ reference = "${test_source_directory}/pr2195.opt.reference"
+ compare_programs = "false"
+*)
+
+let () =
+ Printexc.record_backtrace true;
+ let c = open_out "foo" in
+ close_out c;
+ try
+ while true do
+ open_in "foo" |> ignore
+ done
+ with Sys_error _ ->
+ (* The message is platform-specific, so convert the exception to Exit *)
+ let bt = Printexc.get_raw_backtrace () in
+ Printexc.raise_with_backtrace Exit bt
--- /dev/null
+Fatal error: exception Stdlib.Exit
+Raised by primitive operation at Stdlib.open_in_gen in file "stdlib.ml", line 399, characters 28-54
+Called from Stdlib.open_in in file "stdlib.ml" (inlined), line 404, characters 2-45
+Called from Pr2195 in file "pr2195.ml", line 24, characters 6-19
+Re-raised at Pr2195 in file "pr2195.ml", line 29, characters 4-41
--- /dev/null
+#!/bin/sh
+
+# ulimit -n will have no effect on the Windows builds. The number of open files
+# on Windows is theoretically limited by available memory only, however the CRT
+# is limited to 8192 open files (including the standard handles).
+ulimit -n 32
+
+${program} > ${output} 2>&1
+echo 'exit_status="'$?'"' > ${ocamltest_response}
ocamlrunparam += ",b=1"
ocamlopt_flags = "-inline 0"
exit_status = "2"
- compare_programs = "false"
*)
let why : unit -> unit = fun () -> raise Exit [@@inline never]
() [@@inline never]
let () =
- Printexc.record_backtrace true;
f ()
Fatal error: exception Stdlib.Exit
-Raised at Pr6920_why_at.why in file "pr6920_why_at.ml", line 9, characters 35-45
-Called from Pr6920_why_at.f in file "pr6920_why_at.ml", line 11, characters 2-11
-Called from Pr6920_why_at in file "pr6920_why_at.ml", line 17, characters 2-6
+Raised at Pr6920_why_at.why in file "pr6920_why_at.ml", line 8, characters 35-45
+Called from Pr6920_why_at.f in file "pr6920_why_at.ml", line 10, characters 2-11
+Called from Pr6920_why_at in file "pr6920_why_at.ml", line 15, characters 2-6
ocamlrunparam += ",b=1"
ocamlopt_flags = "-inline 0"
exit_status = "2"
- compare_programs = "false"
*)
let why : unit -> unit = fun () -> raise Exit [@@inline never]
() [@@inline never]
let () =
- Printexc.record_backtrace true;
f ()
Fatal error: exception Stdlib.Exit
-Raised at Pr6920_why_swallow.why in file "pr6920_why_swallow.ml", line 9, characters 35-45
-Called from Pr6920_why_swallow.f in file "pr6920_why_swallow.ml", line 12, characters 4-13
-Called from Pr6920_why_swallow in file "pr6920_why_swallow.ml", line 19, characters 2-6
+Raised at Pr6920_why_swallow.why in file "pr6920_why_swallow.ml", line 8, characters 35-45
+Called from Pr6920_why_swallow.f in file "pr6920_why_swallow.ml", line 11, characters 4-13
+Called from Pr6920_why_swallow in file "pr6920_why_swallow.ml", line 17, characters 2-6
(* TEST
flags = "-g"
ocamlrunparam += ",b=1"
- compare_programs = "false"
*)
(* A test for stack backtraces *)
flush stdout
let _ =
- Printexc.record_backtrace true;
run [| "a" |];
run [| "b" |];
run [| "c" |];
No exception
b
Uncaught exception Raw_backtrace.Error("b")
-Raised at Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 16-32
-Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
-Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
-Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
-Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
-Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
-Called from Raw_backtrace.g in file "raw_backtrace.ml", line 21, characters 4-11
-Re-raised at Raw_backtrace.g in file "raw_backtrace.ml", line 23, characters 62-71
-Called from Raw_backtrace.backtrace in file "raw_backtrace.ml", line 38, characters 11-23
+Raised at Raw_backtrace.f in file "raw_backtrace.ml", line 11, characters 16-32
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 11, characters 42-53
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 11, characters 42-53
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 11, characters 42-53
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 11, characters 42-53
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 11, characters 42-53
+Called from Raw_backtrace.g in file "raw_backtrace.ml", line 20, characters 4-11
+Re-raised at Raw_backtrace.g in file "raw_backtrace.ml", line 22, characters 62-71
+Called from Raw_backtrace.backtrace in file "raw_backtrace.ml", line 37, characters 11-23
Uncaught exception Raw_backtrace.Error("c")
-Raised at Raw_backtrace.g in file "raw_backtrace.ml", line 24, characters 20-37
-Called from Raw_backtrace.backtrace in file "raw_backtrace.ml", line 38, characters 11-23
+Raised at Raw_backtrace.g in file "raw_backtrace.ml", line 23, characters 20-37
+Called from Raw_backtrace.backtrace in file "raw_backtrace.ml", line 37, characters 11-23
Uncaught exception Raw_backtrace.Error("d")
-Raised at Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 16-32
-Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
-Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
-Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
-Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
-Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
-Called from Raw_backtrace.g in file "raw_backtrace.ml", line 21, characters 4-11
-Called from Raw_backtrace.backtrace in file "raw_backtrace.ml", line 38, characters 11-23
+Raised at Raw_backtrace.f in file "raw_backtrace.ml", line 11, characters 16-32
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 11, characters 42-53
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 11, characters 42-53
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 11, characters 42-53
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 11, characters 42-53
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 11, characters 42-53
+Called from Raw_backtrace.g in file "raw_backtrace.ml", line 20, characters 4-11
+Called from Raw_backtrace.backtrace in file "raw_backtrace.ml", line 37, characters 11-23
e
Uncaught exception Raw_backtrace.Error("e")
-Raised at Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 16-32
-Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
-Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
-Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
-Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
-Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
-Called from Raw_backtrace.g in file "raw_backtrace.ml", line 21, characters 4-11
-Re-raised at Raw_backtrace.g in file "raw_backtrace.ml", line 30, characters 9-45
-Called from Raw_backtrace.backtrace in file "raw_backtrace.ml", line 38, characters 11-23
+Raised at Raw_backtrace.f in file "raw_backtrace.ml", line 11, characters 16-32
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 11, characters 42-53
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 11, characters 42-53
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 11, characters 42-53
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 11, characters 42-53
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 11, characters 42-53
+Called from Raw_backtrace.g in file "raw_backtrace.ml", line 20, characters 4-11
+Re-raised at Raw_backtrace.g in file "raw_backtrace.ml", line 29, characters 9-45
+Called from Raw_backtrace.backtrace in file "raw_backtrace.ml", line 37, characters 11-23
f
Uncaught exception Raw_backtrace.Localized(_)
-Raised at Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 16-32
-Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
-Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
-Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
-Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
-Called from Raw_backtrace.f in file "raw_backtrace.ml", line 12, characters 42-53
-Called from Raw_backtrace.g in file "raw_backtrace.ml", line 21, characters 4-11
-Re-raised at Raw_backtrace.g in file "raw_backtrace.ml", line 34, characters 9-57
-Called from Raw_backtrace.backtrace in file "raw_backtrace.ml", line 38, characters 11-23
+Raised at Raw_backtrace.f in file "raw_backtrace.ml", line 11, characters 16-32
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 11, characters 42-53
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 11, characters 42-53
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 11, characters 42-53
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 11, characters 42-53
+Called from Raw_backtrace.f in file "raw_backtrace.ml", line 11, characters 42-53
+Called from Raw_backtrace.g in file "raw_backtrace.ml", line 20, characters 4-11
+Re-raised at Raw_backtrace.g in file "raw_backtrace.ml", line 33, characters 9-57
+Called from Raw_backtrace.backtrace in file "raw_backtrace.ml", line 37, characters 11-23
Uncaught exception Invalid_argument("index out of bounds")
-Raised by primitive operation at Raw_backtrace.backtrace in file "raw_backtrace.ml", line 38, characters 14-22
+Raised by primitive operation at Raw_backtrace.backtrace in file "raw_backtrace.ml", line 37, characters 14-22
(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 0a) s = (makemutable 0 ""))
+ (let (f = (function param 0) s = (makemutable 0 ""))
(seq
(ignore
(let (*match* = (setfield_ptr 0 s "Hello World!"))
(makeblock 0)))
(let
- (drop = (function param 0a) *match* = (apply drop (field 0 s)))
+ (drop = (function param 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 0a) s = (makemutable 0 ""))
+ (let (f = (function param 0) s = (makemutable 0 ""))
(seq
(ignore
(let (*match* = (setfield_ptr 0 s "Hello World!")) (makeblock 0)))
- (let
- (drop = (function param 0a) *match* = (apply drop (field 0 s)))
+ (let (drop = (function param 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 0a))
+ (let (f = (function param 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 0a))
+ (let (drop = (function param 0))
(setfield_ptr(root-init) 4 (global Anonymous!) drop))
(let
(*match* =
(apply (field 4 (global Anonymous!))
(field 0 (field 3 (global Anonymous!)))))
- 0a)
- 0a)))
+ 0)
+ 0)))
File "morematch.ml", line 67, characters 2-5:
67 | | 4|5|7 -> 100
^^^
-Warning 12: this sub-pattern is unused.
+Warning 12 [redundant-subpat]: this sub-pattern is unused.
File "morematch.ml", line 68, characters 2-3:
68 | | 7 | 8 -> 6
^
-Warning 12: this sub-pattern is unused.
+Warning 12 [redundant-subpat]: this sub-pattern is unused.
File "morematch.ml", line 219, characters 33-47:
219 | let f = function (([]|[_]) as x)|(_::([] as x))|(_::_::x) -> x
^^^^^^^^^^^^^^
-Warning 12: this sub-pattern is unused.
+Warning 12 [redundant-subpat]: this sub-pattern is unused.
File "morematch.ml", line 388, characters 2-15:
388 | | A,_,(100|103) -> 5
^^^^^^^^^^^^^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
File "morematch.ml", line 401, characters 2-20:
401 | | [],_,(100|103|104) -> 5
^^^^^^^^^^^^^^^^^^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
File "morematch.ml", line 402, characters 2-16:
402 | | [],_,(100|103) -> 6
^^^^^^^^^^^^^^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
File "morematch.ml", line 403, characters 2-29:
403 | | [],_,(1000|1001|1002|20000) -> 7
^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
File "morematch.ml", line 413, characters 5-12:
413 | | (100|103|101) -> 2
^^^^^^^
-Warning 12: this sub-pattern is unused.
+Warning 12 [redundant-subpat]: this sub-pattern is unused.
File "morematch.ml", line 432, characters 43-44:
432 | | (J,J,((C|D) as x |E x|F (_,x))) | (J,_,((C|J) as x)) -> autre (x,x,x)
^
-Warning 12: this sub-pattern is unused.
+Warning 12 [redundant-subpat]: this sub-pattern is unused.
File "morematch.ml", line 455, characters 7-8:
455 | | _,_,(X|U _) -> 8
^
-Warning 12: this sub-pattern is unused.
+Warning 12 [redundant-subpat]: this sub-pattern is unused.
File "morematch.ml", line 456, characters 2-7:
456 | | _,_,Y -> 5
^^^^^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
File "morematch.ml", lines 1050-1053, characters 8-10:
1050 | ........function
1051 | | A (`A|`C) -> 0
1052 | | B (`B,`D) -> 1
1053 | | C -> 2
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
-(A `D|B (`B, (`A|`C)))
+A `D
File "morematch.ml", line 1084, characters 5-51:
1084 | | _, _, _, _, _, A, _, _, _, _, B, _, _, _, _, _ -> "11"
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
File "morematch.ml", line 1086, characters 5-51:
1086 | | _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ -> "13"
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
35 | | MAB, _, A -> ()
36 | | _, AB, B -> ()
37 | | _, MAB, B -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(AB, MAB, A)
File "robustmatch.ml", lines 43-47, characters 4-21:
45 | | MAB, _, A -> ()
46 | | _, AB, B -> ()
47 | | _, MAB, B -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(AB, MAB, A)
File "robustmatch.ml", lines 54-56, characters 4-27:
54 | ....match r1, r2, a with
55 | | R1, _, 0 -> ()
56 | | _, R2, "coucou" -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(R1, R1, 1)
File "robustmatch.ml", lines 64-66, characters 4-27:
64 | ....match r1, r2, a with
65 | | R1, _, A -> ()
66 | | _, R2, "coucou" -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(R1, R1, (B|C))
File "robustmatch.ml", lines 69-71, characters 4-20:
69 | ....match r1, r2, a with
70 | | _, R2, "coucou" -> ()
71 | | R1, _, A -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(R1, R1, (B|C))
File "robustmatch.ml", lines 74-76, characters 4-20:
74 | ....match r1, r2, a with
75 | | _, R2, "coucou" -> ()
76 | | R1, _, _ -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(R2, R2, "")
File "robustmatch.ml", lines 85-87, characters 4-20:
85 | ....match r1, r2, a with
86 | | R1, _, A -> ()
87 | | _, R2, X -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(R1, R1, (B|C))
File "robustmatch.ml", lines 90-93, characters 4-20:
91 | | R1, _, A -> ()
92 | | _, R2, X -> ()
93 | | R1, _, _ -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(R2, R2, (Y|Z))
File "robustmatch.ml", lines 96-98, characters 4-20:
96 | ....match r1, r2, a with
97 | | R1, _, _ -> ()
98 | | _, R2, X -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(R2, R2, (Y|Z))
File "robustmatch.ml", lines 107-109, characters 4-20:
107 | ....match r1, r2, a with
108 | | R1, _, A -> ()
109 | | _, R2, X -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(R1, R1, (B|C))
File "robustmatch.ml", lines 129-131, characters 4-20:
129 | ....match r1, r2, a with
130 | | R1, _, A -> ()
131 | | _, R2, X -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(R1, R1, B)
File "robustmatch.ml", lines 151-153, characters 4-20:
151 | ....match r1, r2, a with
152 | | R1, _, A -> ()
153 | | _, R2, X -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(R1, R1, B)
File "robustmatch.ml", lines 156-159, characters 4-20:
157 | | R1, _, A -> ()
158 | | _, R2, X -> ()
159 | | R1, _, _ -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(R2, R2, Y)
File "robustmatch.ml", lines 162-164, characters 4-20:
162 | ....match r1, r2, a with
163 | | R1, _, _ -> ()
164 | | _, R2, X -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(R2, R2, Y)
File "robustmatch.ml", lines 167-169, characters 4-20:
167 | ....match r1, r2, a with
168 | | R1, _, C -> ()
169 | | _, R2, Y -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(R1, R1, A)
File "robustmatch.ml", lines 176-179, characters 4-20:
177 | | _, R1, 0 -> ()
178 | | R2, _, [||] -> ()
179 | | _, R1, 1 -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(R2, R2, [| _ |])
File "robustmatch.ml", lines 182-184, characters 4-23:
182 | ....match r1, r2, a with
183 | | R1, _, _ -> ()
184 | | _, R2, [||] -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(R2, R2, [| _ |])
File "robustmatch.ml", lines 187-190, characters 4-20:
188 | | _, R2, [||] -> ()
189 | | R1, _, 0 -> ()
190 | | R1, _, _ -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(R2, R2, [| _ |])
File "robustmatch.ml", lines 200-203, characters 4-19:
201 | | _, R2, [||] -> ()
202 | | R1, _, 0 -> ()
203 | | _, _, _ -> ()
-Warning 4: this pattern-matching is fragile.
+Warning 4 [fragile-match]: this pattern-matching is fragile.
It will remain exhaustive when constructors are added to type repr.
File "robustmatch.ml", lines 210-212, characters 4-27:
210 | ....match r1, r2, a with
211 | | R1, _, 'c' -> ()
212 | | _, R2, "coucou" -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(R1, R1, 'a')
File "robustmatch.ml", lines 219-221, characters 4-27:
219 | ....match r1, r2, a with
220 | | R1, _, `A -> ()
221 | | _, R2, "coucou" -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(R1, R1, `B)
File "robustmatch.ml", lines 228-230, characters 4-37:
228 | ....match r1, r2, a with
229 | | R1, _, (3, "") -> ()
230 | | _, R2, (1, "coucou", 'a') -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(R1, R1, (3, "*"))
File "robustmatch.ml", lines 239-241, characters 4-51:
239 | ....match r1, r2, a with
240 | | R1, _, { x = 3; y = "" } -> ()
241 | | _, R2, { a = 1; b = "coucou"; c = 'a' } -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(R1, R1, {x=3; y="*"})
File "robustmatch.ml", lines 244-246, characters 4-36:
244 | ....match r1, r2, a with
245 | | R2, _, { a = 1; b = "coucou"; c = 'a' } -> ()
246 | | _, R1, { x = 3; y = "" } -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(R2, R2, {a=1; b="coucou"; c='b'})
File "robustmatch.ml", lines 253-255, characters 4-20:
253 | ....match r1, r2, a with
254 | | R1, _, (3, "") -> ()
255 | | _, R2, 1 -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(R1, R1, (3, "*"))
File "robustmatch.ml", lines 263-265, characters 4-20:
263 | ....match r1, r2, a with
264 | | R1, _, { x = 3; y = "" } -> ()
265 | | _, R2, 1 -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(R1, R1, {x=3; y="*"})
File "robustmatch.ml", lines 272-274, characters 4-20:
272 | ....match r1, r2, a with
273 | | R1, _, lazy 1 -> ()
274 | | _, R2, 1 -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(R1, R1, lazy 0)
File "robustmatch.ml", lines 281-284, characters 4-24:
282 | | R1, _, () -> ()
283 | | _, R2, "coucou" -> ()
284 | | _, R2, "foo" -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(R2, R2, "")
let eqftffff =
function (false,true,false,false,false,false) -> true | _ -> false
+let eqfun delayed_check =
+ match delayed_check () with
+ | exception Invalid_argument _ -> true
+ | _ -> false
+
let x = [1;2;3]
let f x = 1 :: 2 :: 3 :: x
for i = 1 to len do l := Cons(!l, i) done;
!l
+(* use an existential to check equality with different tags *)
+type any = Any : 'a -> any
+
let _ =
test 1 eq0 (compare 0 0);
test 2 eqm1 (compare 0 1);
test 52 eqtrue (testcmpfloat 0.0 nan);
test 53 eqtrue (testcmpfloat 0.0 0.0);
test 54 eqtrue (testcmpfloat 1.0 0.0);
- test 55 eqtrue (testcmpfloat 0.0 1.0)
+ test 55 eqtrue (testcmpfloat 0.0 1.0);
+ test 56 eqfun (fun () -> compare (fun x -> x) (fun x -> x));
+ test 57 eqfun (fun () ->
+ (* #9521 *)
+ let rec f x = g x and g x = f x in compare f g);
+
+ (* this is the current behavior of comparison
+ with values of incoherent types (packed below
+ an existential), but it may not be the only specification. *)
+ test 58 eqm1
+ (compare (Any 0) (Any 2));
+ begin
+ (* comparing two function fails *)
+ test 59 eqfun (fun () ->
+ compare (Any (fun x -> x)) (Any (fun x -> x + 1)));
+ (* comparing a function and a non-function succeeds *)
+ test 60 (Fun.negate eq0)
+ (compare (Any (fun x -> x)) (Any 0));
+ test 61 (Fun.negate eq0)
+ (compare (Any 0) (Any (fun x -> x)));
+ end;
+ ()
Test 53 passed.
Test 54 passed.
Test 55 passed.
+Test 56 passed.
+Test 57 passed.
+Test 58 passed.
+Test 59 passed.
+Test 60 passed.
+Test 61 passed.
--- /dev/null
+(* TEST
+ flags = "-drawlambda"
+ * expect
+*)
+
+(* Successful flattening *)
+
+match (3, 2, 1) with
+| (_, 3, _)
+| (1, _, _) -> true
+| _ -> false
+;;
+[%%expect{|
+(let
+ (*match*/88 = 3
+ *match*/89 = 2
+ *match*/90 = 1
+ *match*/91 = *match*/88
+ *match*/92 = *match*/89
+ *match*/93 = *match*/90)
+ (catch
+ (catch
+ (catch (if (!= *match*/92 3) (exit 3) (exit 1)) with (3)
+ (if (!= *match*/91 1) (exit 2) (exit 1)))
+ with (2) 0)
+ with (1) 1))
+- : bool = false
+|}];;
+
+(* Failed flattening: we need to allocate the tuple to bind x. *)
+
+match (3, 2, 1) with
+| ((_, 3, _) as x)
+| ((1, _, _) as x) -> ignore x; true
+| _ -> false
+;;
+[%%expect{|
+(let
+ (*match*/96 = 3
+ *match*/97 = 2
+ *match*/98 = 1
+ *match*/99 = (makeblock 0 *match*/96 *match*/97 *match*/98))
+ (catch
+ (catch
+ (let (*match*/100 =a (field 0 *match*/99))
+ (catch
+ (let (*match*/101 =a (field 1 *match*/99))
+ (if (!= *match*/101 3) (exit 7)
+ (let (*match*/102 =a (field 2 *match*/99)) (exit 5 *match*/99))))
+ with (7)
+ (if (!= *match*/100 1) (exit 6)
+ (let
+ (*match*/104 =a (field 2 *match*/99)
+ *match*/103 =a (field 1 *match*/99))
+ (exit 5 *match*/99)))))
+ with (6) 0)
+ with (5 x/94) (seq (ignore x/94) 1)))
+- : bool = false
+|}];;
1 | match { x = assert false } with
2 | | { x = 3 } -> ()
3 | | { x = None } -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
{x=Some _}
Exception: Assert_failure ("", 1, 12).
1 | match { x = assert false } with
2 | | { x = None } -> ()
3 | | { x = "" } -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
{x="*"}
Exception: Assert_failure ("", 1, 12).
1 | match { x = assert false } with
2 | | { x = None } -> ()
3 | | { x = `X } -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
{x=`AnyOtherTag}
Exception: Assert_failure ("", 1, 12).
1 | match { x = assert false } with
2 | | { x = [||] } -> ()
3 | | { x = 3 } -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
{x=0}
Exception: Assert_failure ("", 1, 12).
1 | match { x = assert false } with
2 | | { x = `X } -> ()
3 | | { x = 3 } -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
{x=0}
Exception: Assert_failure ("", 1, 12).
1 | match { x = assert false } with
2 | | { x = `X "lol" } -> ()
3 | | { x = 3 } -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
{x=0}
Exception: Assert_failure ("", 1, 12).
2 | | { x = (2., "") } -> ()
3 | | { x = None } -> ()
4 | | { x = 3 } -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
{x=0}
Exception: Assert_failure ("", 1, 12).
type t = ..
type t += A | B of unit | C of bool * int;;
[%%expect{|
-0a
+0
type t = ..
(let
(A/25 = (makeblock 248 "A" (caml_fresh_oo_id 0))
/* */
/**************************************************************************/
+#include <signal.h>
#include "caml/mlvalues.h"
#include "caml/memory.h"
#include "caml/callback.h"
v = x;
CAMLreturn (v);
}
+
+value raise_sigusr1(value unused)
+{
+ raise(SIGUSR1);
+ return Val_unit;
+}
(* TEST
include unix
+ modules = "callbackprim.c"
* libunix
** bytecode
** native
*)
-
-let pid = Unix.getpid ()
+external raise_sigusr1 : unit -> unit = "raise_sigusr1"
let do_test () =
let seen_states = Array.make 5 (-1) in
seen_states.(!pos) <- 0; pos := !pos + 1;
Sys.set_signal Sys.sigusr1 (Sys.Signal_handle sighandler);
seen_states.(!pos) <- 1; pos := !pos + 1;
- Unix.kill pid Sys.sigusr1;
+ raise_sigusr1 ();
seen_states.(!pos) <- 2; pos := !pos + 1;
let _ = Sys.opaque_identity (ref 1) in
seen_states.(!pos) <- 4; pos := !pos + 1;
Sys.set_signal Sys.sigusr1 Sys.Signal_default;
- assert (seen_states = [|0;1;2;3;4|])
+ Array.iter (Printf.printf "%d") seen_states;
+ print_newline ()
let () =
for _ = 0 to 10 do do_test () done;
+01234
+01234
+01234
+01234
+01234
+01234
+01234
+01234
+01234
+01234
+01234
OK
(* Thoroughly wipe the minor heap *)
ignore (tak (18, 12, 6))
-external unix_getpid : unit -> int = "unix_getpid" [@@noalloc]
-external unix_kill : int -> int -> unit = "unix_kill" [@@noalloc]
+external raise_sigusr1 : unit -> unit = "raise_sigusr1" [@@noalloc]
let callbacksig () =
- let pid = unix_getpid() in
(* Allocate a block in the minor heap *)
let s = String.make 5 'b' in
(* Send a signal to self. We want s to remain in a register and
- not be spilled on the stack, hence we declare unix_kill
- [@@noalloc]. *)
- unix_kill pid Sys.sigusr1;
+ not be spilled on the stack, hence we use a [@@noalloc] stub *)
+ raise_sigusr1 ();
(* Allocate some more so that the signal will be tested *)
let u = (s, s) in
fst u
--- /dev/null
+(* TEST
+ * flambda
+ ** native
+ ocamlopt_flags = "-O3 -afl-instrument"
+*)
+
+let f l =
+ Lazy.force l
+
+let _ =
+ Sys.opaque_identity (f (lazy "Hello"))
ocamlc_flags = "config.cmo"
ocamlopt_flags = "-inline 20 config.cmx"
* native
- compare_programs = "false"
*)
let eliminate_intermediate_float_record () =
[
- structure_item (test_locations.ml[42,1260+0]..[44,1298+34])
+ structure_item (test_locations.ml[17,534+0]..[19,572+34])
Pstr_value Rec
[
<def>
- pattern (test_locations.ml[42,1260+8]..[42,1260+11])
- Ppat_var "fib" (test_locations.ml[42,1260+8]..[42,1260+11])
- expression (test_locations.ml[42,1260+14]..[44,1298+34])
+ pattern (test_locations.ml[17,534+8]..[17,534+11])
+ Ppat_var "fib" (test_locations.ml[17,534+8]..[17,534+11])
+ expression (test_locations.ml[17,534+14]..[19,572+34])
Pexp_function
[
<case>
- pattern (test_locations.ml[43,1283+4]..[43,1283+9])
+ pattern (test_locations.ml[18,557+4]..[18,557+9])
Ppat_or
- pattern (test_locations.ml[43,1283+4]..[43,1283+5])
+ pattern (test_locations.ml[18,557+4]..[18,557+5])
Ppat_constant PConst_int (0,None)
- pattern (test_locations.ml[43,1283+8]..[43,1283+9])
+ pattern (test_locations.ml[18,557+8]..[18,557+9])
Ppat_constant PConst_int (1,None)
- expression (test_locations.ml[43,1283+13]..[43,1283+14])
+ expression (test_locations.ml[18,557+13]..[18,557+14])
Pexp_constant PConst_int (1,None)
<case>
- pattern (test_locations.ml[44,1298+4]..[44,1298+5])
- Ppat_var "n" (test_locations.ml[44,1298+4]..[44,1298+5])
- expression (test_locations.ml[44,1298+9]..[44,1298+34])
+ pattern (test_locations.ml[19,572+4]..[19,572+5])
+ Ppat_var "n" (test_locations.ml[19,572+4]..[19,572+5])
+ expression (test_locations.ml[19,572+9]..[19,572+34])
Pexp_apply
- expression (test_locations.ml[44,1298+21]..[44,1298+22])
- Pexp_ident "+" (test_locations.ml[44,1298+21]..[44,1298+22])
+ expression (test_locations.ml[19,572+21]..[19,572+22])
+ Pexp_ident "+" (test_locations.ml[19,572+21]..[19,572+22])
[
<arg>
Nolabel
- expression (test_locations.ml[44,1298+9]..[44,1298+20])
+ expression (test_locations.ml[19,572+9]..[19,572+20])
Pexp_apply
- expression (test_locations.ml[44,1298+9]..[44,1298+12])
- Pexp_ident "fib" (test_locations.ml[44,1298+9]..[44,1298+12])
+ expression (test_locations.ml[19,572+9]..[19,572+12])
+ Pexp_ident "fib" (test_locations.ml[19,572+9]..[19,572+12])
[
<arg>
Nolabel
- expression (test_locations.ml[44,1298+13]..[44,1298+20])
+ expression (test_locations.ml[19,572+13]..[19,572+20])
Pexp_apply
- expression (test_locations.ml[44,1298+16]..[44,1298+17])
- Pexp_ident "-" (test_locations.ml[44,1298+16]..[44,1298+17])
+ expression (test_locations.ml[19,572+16]..[19,572+17])
+ Pexp_ident "-" (test_locations.ml[19,572+16]..[19,572+17])
[
<arg>
Nolabel
- expression (test_locations.ml[44,1298+14]..[44,1298+15])
- Pexp_ident "n" (test_locations.ml[44,1298+14]..[44,1298+15])
+ expression (test_locations.ml[19,572+14]..[19,572+15])
+ Pexp_ident "n" (test_locations.ml[19,572+14]..[19,572+15])
<arg>
Nolabel
- expression (test_locations.ml[44,1298+18]..[44,1298+19])
+ expression (test_locations.ml[19,572+18]..[19,572+19])
Pexp_constant PConst_int (1,None)
]
]
<arg>
Nolabel
- expression (test_locations.ml[44,1298+23]..[44,1298+34])
+ expression (test_locations.ml[19,572+23]..[19,572+34])
Pexp_apply
- expression (test_locations.ml[44,1298+23]..[44,1298+26])
- Pexp_ident "fib" (test_locations.ml[44,1298+23]..[44,1298+26])
+ expression (test_locations.ml[19,572+23]..[19,572+26])
+ Pexp_ident "fib" (test_locations.ml[19,572+23]..[19,572+26])
[
<arg>
Nolabel
- expression (test_locations.ml[44,1298+27]..[44,1298+34])
+ expression (test_locations.ml[19,572+27]..[19,572+34])
Pexp_apply
- expression (test_locations.ml[44,1298+30]..[44,1298+31])
- Pexp_ident "-" (test_locations.ml[44,1298+30]..[44,1298+31])
+ expression (test_locations.ml[19,572+30]..[19,572+31])
+ Pexp_ident "-" (test_locations.ml[19,572+30]..[19,572+31])
[
<arg>
Nolabel
- expression (test_locations.ml[44,1298+28]..[44,1298+29])
- Pexp_ident "n" (test_locations.ml[44,1298+28]..[44,1298+29])
+ expression (test_locations.ml[19,572+28]..[19,572+29])
+ Pexp_ident "n" (test_locations.ml[19,572+28]..[19,572+29])
<arg>
Nolabel
- expression (test_locations.ml[44,1298+32]..[44,1298+33])
+ expression (test_locations.ml[19,572+32]..[19,572+33])
Pexp_constant PConst_int (2,None)
]
]
]
]
-let rec fib = function | 0|1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2))
+let rec fib = function | 0 | 1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2))
[
- structure_item (test_locations.ml[42,1260+0]..test_locations.ml[44,1298+34])
+ structure_item (test_locations.ml[17,534+0]..test_locations.ml[19,572+34])
Tstr_value Rec
[
<def>
- pattern (test_locations.ml[42,1260+8]..test_locations.ml[42,1260+11])
- Tpat_var "fib/80"
- expression (test_locations.ml[42,1260+14]..test_locations.ml[44,1298+34])
+ pattern (test_locations.ml[17,534+8]..test_locations.ml[17,534+11])
+ Tpat_var "fib"
+ expression (test_locations.ml[17,534+14]..test_locations.ml[19,572+34])
Texp_function
Nolabel
[
<case>
- pattern (test_locations.ml[43,1283+4]..test_locations.ml[43,1283+9])
+ pattern (test_locations.ml[18,557+4]..test_locations.ml[18,557+9])
Tpat_or
- pattern (test_locations.ml[43,1283+4]..test_locations.ml[43,1283+5])
+ pattern (test_locations.ml[18,557+4]..test_locations.ml[18,557+5])
Tpat_constant Const_int 0
- pattern (test_locations.ml[43,1283+8]..test_locations.ml[43,1283+9])
+ pattern (test_locations.ml[18,557+8]..test_locations.ml[18,557+9])
Tpat_constant Const_int 1
- expression (test_locations.ml[43,1283+13]..test_locations.ml[43,1283+14])
+ expression (test_locations.ml[18,557+13]..test_locations.ml[18,557+14])
Texp_constant Const_int 1
<case>
- pattern (test_locations.ml[44,1298+4]..test_locations.ml[44,1298+5])
- Tpat_var "n/81"
- expression (test_locations.ml[44,1298+9]..test_locations.ml[44,1298+34])
+ pattern (test_locations.ml[19,572+4]..test_locations.ml[19,572+5])
+ Tpat_var "n"
+ expression (test_locations.ml[19,572+9]..test_locations.ml[19,572+34])
Texp_apply
- expression (test_locations.ml[44,1298+21]..test_locations.ml[44,1298+22])
+ expression (test_locations.ml[19,572+21]..test_locations.ml[19,572+22])
Texp_ident "Stdlib!.+"
[
<arg>
Nolabel
- expression (test_locations.ml[44,1298+9]..test_locations.ml[44,1298+20])
+ expression (test_locations.ml[19,572+9]..test_locations.ml[19,572+20])
Texp_apply
- expression (test_locations.ml[44,1298+9]..test_locations.ml[44,1298+12])
- Texp_ident "fib/80"
+ expression (test_locations.ml[19,572+9]..test_locations.ml[19,572+12])
+ Texp_ident "fib"
[
<arg>
Nolabel
- expression (test_locations.ml[44,1298+13]..test_locations.ml[44,1298+20])
+ expression (test_locations.ml[19,572+13]..test_locations.ml[19,572+20])
Texp_apply
- expression (test_locations.ml[44,1298+16]..test_locations.ml[44,1298+17])
+ expression (test_locations.ml[19,572+16]..test_locations.ml[19,572+17])
Texp_ident "Stdlib!.-"
[
<arg>
Nolabel
- expression (test_locations.ml[44,1298+14]..test_locations.ml[44,1298+15])
- Texp_ident "n/81"
+ expression (test_locations.ml[19,572+14]..test_locations.ml[19,572+15])
+ Texp_ident "n"
<arg>
Nolabel
- expression (test_locations.ml[44,1298+18]..test_locations.ml[44,1298+19])
+ expression (test_locations.ml[19,572+18]..test_locations.ml[19,572+19])
Texp_constant Const_int 1
]
]
<arg>
Nolabel
- expression (test_locations.ml[44,1298+23]..test_locations.ml[44,1298+34])
+ expression (test_locations.ml[19,572+23]..test_locations.ml[19,572+34])
Texp_apply
- expression (test_locations.ml[44,1298+23]..test_locations.ml[44,1298+26])
- Texp_ident "fib/80"
+ expression (test_locations.ml[19,572+23]..test_locations.ml[19,572+26])
+ Texp_ident "fib"
[
<arg>
Nolabel
- expression (test_locations.ml[44,1298+27]..test_locations.ml[44,1298+34])
+ expression (test_locations.ml[19,572+27]..test_locations.ml[19,572+34])
Texp_apply
- expression (test_locations.ml[44,1298+30]..test_locations.ml[44,1298+31])
+ expression (test_locations.ml[19,572+30]..test_locations.ml[19,572+31])
Texp_ident "Stdlib!.-"
[
<arg>
Nolabel
- expression (test_locations.ml[44,1298+28]..test_locations.ml[44,1298+29])
- Texp_ident "n/81"
+ expression (test_locations.ml[19,572+28]..test_locations.ml[19,572+29])
+ Texp_ident "n"
<arg>
Nolabel
- expression (test_locations.ml[44,1298+32]..test_locations.ml[44,1298+33])
+ expression (test_locations.ml[19,572+32]..test_locations.ml[19,572+33])
Texp_constant Const_int 2
]
]
(setglobal Test_locations!
(letrec
- (fib/80
- (function n/81[int] : int
- (funct-body Test_locations.fib test_locations.ml(42):1274-1332
- (if (isout 1 n/81)
- (before Test_locations.fib test_locations.ml(44):1307-1332
+ (fib
+ (function n[int] : int
+ (funct-body Test_locations.fib test_locations.ml(17):548-606
+ (if (isout 1 n)
+ (before Test_locations.fib test_locations.ml(19):581-606
(+
- (after Test_locations.fib test_locations.ml(44):1307-1318
- (apply fib/80 (- n/81 1)))
- (after Test_locations.fib test_locations.ml(44):1321-1332
- (apply fib/80 (- n/81 2)))))
- (before Test_locations.fib test_locations.ml(43):1296-1297 1)))))
- (pseudo <unknown location> (makeblock 0 fib/80))))
+ (after Test_locations.fib test_locations.ml(19):581-592
+ (apply fib (- n 1)))
+ (after Test_locations.fib test_locations.ml(19):595-606
+ (apply fib (- n 2)))))
+ (before Test_locations.fib test_locations.ml(18):570-571 1)))))
+ (pseudo <unknown location> (makeblock 0 fib))))
+++ /dev/null
-
-cmm:
-(data)
-(data
- int 3063
- "camlTest_locations__1":
- addr "camlTest_locations__fib_80"
- int 3)
-(data int 1792 global "camlTest_locations" "camlTest_locations": int 1)
-(data
- global "camlTest_locations__gc_roots"
- "camlTest_locations__gc_roots":
- addr "camlTest_locations"
- int 0)
-(function{test_locations.ml:42,14-72} camlTest_locations__fib_80 (n/81: val)
- (if (<a 3 n/81)
- (+
- (+
- (app{test_locations.ml:44,9-20} "camlTest_locations__fib_80"
- (+ n/81 -2) val)
- (app{test_locations.ml:44,23-34} "camlTest_locations__fib_80"
- (+ n/81 -4) val))
- -1)
- 3))
-
-(function camlTest_locations__entry ()
- (let clos/84 "camlTest_locations__1"
- (store val(root-init) "camlTest_locations" clos/84))
- 1a)
-
-(data)
+++ /dev/null
-
-cmm:
-(data)
-(data
- int 3063
- global "camlTest_locations__set_of_closures_29"
- "camlTest_locations__set_of_closures_29":
- global "camlTest_locations__fib_5_closure"
- "camlTest_locations__fib_5_closure":
- addr "camlTest_locations__fib_5"
- int 3)
-(data
- global "camlTest_locations__gc_roots"
- "camlTest_locations__gc_roots":
- int 0)
-(function{test_locations.ml:42,14-72} camlTest_locations__fib_5 (n/84: val)
- (if (<a 3 n/84)
- (let
- Paddint_arg/91
- (app{test_locations.ml:44,23-34} "camlTest_locations__fib_5"
- (+ n/84 -4) val)
- (+
- (+
- (app{test_locations.ml:44,9-20} "camlTest_locations__fib_5"
- (+ n/84 -2) val)
- Paddint_arg/91)
- -1))
- 3))
-
-(data
- int 1792
- global "camlTest_locations"
- "camlTest_locations":
- addr "camlTest_locations__fib_5_closure")
-(data)
-(function camlTest_locations__entry () 1a)
-
-(data)
]
]
-let rec fib = function | 0|1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2))
+let rec fib = function | 0 | 1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2))
[
structure_item
Tstr_value Rec
[
<def>
pattern
- Tpat_var "fib/80"
+ Tpat_var "fib"
expression
Texp_function
Nolabel
Texp_constant Const_int 1
<case>
pattern
- Tpat_var "n/81"
+ Tpat_var "n"
expression
Texp_apply
expression
expression
Texp_apply
expression
- Texp_ident "fib/80"
+ Texp_ident "fib"
[
<arg>
Nolabel
<arg>
Nolabel
expression
- Texp_ident "n/81"
+ Texp_ident "n"
<arg>
Nolabel
expression
expression
Texp_apply
expression
- Texp_ident "fib/80"
+ Texp_ident "fib"
[
<arg>
Nolabel
<arg>
Nolabel
expression
- Texp_ident "n/81"
+ Texp_ident "n"
<arg>
Nolabel
expression
(setglobal Test_locations!
(letrec
- (fib/80
- (function n/81[int] : int
- (if (isout 1 n/81)
- (+ (apply fib/80 (- n/81 1)) (apply fib/80 (- n/81 2))) 1)))
- (makeblock 0 fib/80)))
+ (fib
+ (function n[int] : int
+ (if (isout 1 n) (+ (apply fib (- n 1)) (apply fib (- n 2))) 1)))
+ (makeblock 0 fib)))
+++ /dev/null
-
-cmm:
-(data)
-(data
- int 3063
- "camlTest_locations__1":
- addr "camlTest_locations__fib_80"
- int 3)
-(data int 1792 global "camlTest_locations" "camlTest_locations": int 1)
-(data
- global "camlTest_locations__gc_roots"
- "camlTest_locations__gc_roots":
- addr "camlTest_locations"
- int 0)
-(function camlTest_locations__fib_80 (n/81: val)
- (if (<a 3 n/81)
- (+
- (+ (app "camlTest_locations__fib_80" (+ n/81 -2) val)
- (app "camlTest_locations__fib_80" (+ n/81 -4) val))
- -1)
- 3))
-
-(function camlTest_locations__entry ()
- (let clos/84 "camlTest_locations__1"
- (store val(root-init) "camlTest_locations" clos/84))
- 1a)
-
-(data)
+++ /dev/null
-
-cmm:
-(data)
-(data
- int 3063
- global "camlTest_locations__set_of_closures_29"
- "camlTest_locations__set_of_closures_29":
- global "camlTest_locations__fib_5_closure"
- "camlTest_locations__fib_5_closure":
- addr "camlTest_locations__fib_5"
- int 3)
-(data
- global "camlTest_locations__gc_roots"
- "camlTest_locations__gc_roots":
- int 0)
-(function camlTest_locations__fib_5 (n/84: val)
- (if (<a 3 n/84)
- (let Paddint_arg/91 (app "camlTest_locations__fib_5" (+ n/84 -4) val)
- (+ (+ (app "camlTest_locations__fib_5" (+ n/84 -2) val) Paddint_arg/91)
- -1))
- 3))
-
-(data
- int 1792
- global "camlTest_locations"
- "camlTest_locations":
- addr "camlTest_locations__fib_5_closure")
-(data)
-(function camlTest_locations__entry () 1a)
-
-(data)
(* TEST
compile_only="true"
-
* setup-ocamlc.byte-build-env
** ocamlc.byte
-flags="-g -dno-locations -dsource -dparsetree -dtypedtree -dlambda"
+flags="-g -dno-unique-ids -dno-locations -dsource -dparsetree -dtypedtree -dlambda"
*** check-ocamlc.byte-output
compiler_reference =
"${test_source_directory}/test_locations.dno-locations.ocamlc.reference"
-* setup-ocamlopt.byte-build-env
-** ocamlopt.byte
-flags="-g -dno-locations -dcmm"
-*** no-flambda
-**** check-ocamlopt.byte-output
-compiler_reference =
- "${test_source_directory}/test_locations.dno-locations.ocamlopt.clambda.reference"
-*** flambda
-**** check-ocamlc.byte-output
-compiler_reference =
- "${test_source_directory}/test_locations.dno-locations.ocamlopt.flambda.reference"
-
* setup-ocamlc.byte-build-env
** ocamlc.byte
-flags="-g -dlocations -dsource -dparsetree -dtypedtree -dlambda"
+flags="-g -dno-unique-ids -dlocations -dsource -dparsetree -dtypedtree -dlambda"
*** check-ocamlc.byte-output
compiler_reference =
"${test_source_directory}/test_locations.dlocations.ocamlc.reference"
-
-* setup-ocamlopt.byte-build-env
-** ocamlopt.byte
-flags="-g -dlocations -dcmm"
-*** no-flambda
-**** check-ocamlopt.byte-output
-compiler_reference =
- "${test_source_directory}/test_locations.dlocations.ocamlopt.clambda.reference"
-*** flambda
-**** check-ocamlc.byte-output
-compiler_reference =
- "${test_source_directory}/test_locations.dlocations.ocamlopt.flambda.reference"
*)
let rec fib = function
| 0 | 1 -> 1
val of_list : elt list -> t = <fun>
val to_seq_from : elt -> t -> elt Seq.t = <fun>
val to_seq : t -> elt Seq.t = <fun>
+val to_rev_seq : t -> elt Seq.t = <fun>
val add_seq : elt Seq.t -> t -> t = <fun>
val of_seq : elt Seq.t -> t = <fun>
|}]
Line 1, characters 15-41:
1 | include struct open struct type t = T end let x = T end
^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: The type t/149 introduced by this open appears in the signature
+Error: The type t/150 introduced by this open appears in the signature
Line 1, characters 46-47:
- The value x has no valid type if t/149 is hidden
+ The value x has no valid type if t/150 is hidden
|}];;
module A = struct
4 | type t = T
5 | let x = T
6 | end
-Error: The type t/154 introduced by this open appears in the signature
+Error: The type t/155 introduced by this open appears in the signature
Line 7, characters 8-9:
- The value y has no valid type if t/154 is hidden
+ The value y has no valid type if t/155 is hidden
|}];;
module A = struct
3 | ....open struct
4 | type t = T
5 | end
-Error: The type t/159 introduced by this open appears in the signature
+Error: The type t/160 introduced by this open appears in the signature
Line 6, characters 8-9:
- The value y has no valid type if t/159 is hidden
+ The value y has no valid type if t/160 is hidden
|}]
(* It was decided to not allow this anymore. *)
let f () = let open functor(X: sig end) -> struct end in ();;
[%%expect{|
-Line 1, characters 20-53:
+Line 1, characters 27-53:
1 | let f () = let open functor(X: sig end) -> struct end in ();;
- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This module is not a structure; it has type
functor (X : sig end) -> sig end
|}]
--- /dev/null
+(* TEST
+ * expect
+*)
+module Ext (X : sig type 'a t end) = struct
+ type t = T : 'a X.t -> t
+end;;
+
+let foo (x : Ext(List).t) =
+ match x with
+ | T l ->
+ let open Ext(Array) in
+ T (Array.of_list l);;
+[%%expect {|
+module Ext :
+ functor (X : sig type 'a t end) -> sig type t = T : 'a X.t -> t end
+val foo : Ext(List).t -> Ext(Array).t = <fun>
+|}]
Line 3, characters 9-10:
3 | let+ A = A.A in
^
-Error: Unbound constructor A
+Warning 18 [not-principal]: this type-based constructor disambiguation is not principal.
+val let_not_principal : unit = ()
|}];;
module And_not_principal = struct
Line 5, characters 11-12:
5 | and+ A = y in
^
-Error: Unbound constructor A
+Warning 18 [not-principal]: this type-based constructor disambiguation is not principal.
+val and_not_principal : A.t -> A.t -> unit = <fun>
|}];;
module Let_not_propagated = struct
[%%expect{|
val bad_location : 'a GADT_ordering.is_point -> 'a -> int = <fun>
|}, Principal{|
-Line 4, characters 6-10:
+Line 4, characters 11-19:
4 | let+ Is_point = is_point
- ^^^^
-Error: This pattern matches values of type
- GADT_ordering.point GADT_ordering.is_point * GADT_ordering.point
- but a pattern was expected which matches values of type
- a GADT_ordering.is_point * a
- Type GADT_ordering.point is not compatible with type a
+ ^^^^^^^^
+Warning 18 [not-principal]: typing this pattern requires considering GADT_ordering.point and a as equal.
+But the knowledge of these types is not principal.
+Line 5, characters 13-14:
+5 | and+ { x; y } = a in
+ ^
+Error: The record field x belongs to the type GADT_ordering.point
+ but is mixed here with fields of type a = GADT_ordering.point
+ This instance of GADT_ordering.point is ambiguous:
+ it would escape the scope of its equation
|}];;
Line 5, characters 58-64:
5 | let rec r = let rec x () = r and y () = x () in y () in r "oops";;
^^^^^^
-Warning 20: this argument will not be used by the function.
+Warning 20 [ignored-extra-argument]: this argument will not be used by the function.
Line 5, characters 12-52:
5 | let rec r = let rec x () = r and y () = x () in y () in r "oops";;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Line 7, characters 15-17:
7 | let invalid = "\99" ;;
^^
-Warning 14: illegal backslash escape in string.
+Warning 14 [illegal-backslash]: illegal backslash escape in string.
val invalid : string = "\\99"
Line 1, characters 15-19:
1 | let invalid = "\999" ;;
Line 1, characters 15-17:
1 | let invalid = "\o77" ;;
^^
-Warning 14: illegal backslash escape in string.
+Warning 14 [illegal-backslash]: illegal backslash escape in string.
val invalid : string = "\\o77"
Line 1, characters 15-17:
1 | let invalid = "\o99" ;;
^^
-Warning 14: illegal backslash escape in string.
+Warning 14 [illegal-backslash]: illegal backslash escape in string.
val invalid : string = "\\o99"
Line 1, characters 21-23:
1 | let no_hex_digits = "\u{}" ;;
^^
-Warning 14: illegal backslash escape in string.
+Warning 14 [illegal-backslash]: illegal backslash escape in string.
val no_hex_digits : string = "\\u{}"
Line 1, characters 25-27:
1 | let illegal_hex_digit = "\u{u}" ;;
^^
-Warning 14: illegal backslash escape in string.
+Warning 14 [illegal-backslash]: illegal backslash escape in string.
val illegal_hex_digit : string = "\\u{u}"
--- /dev/null
+(* TEST
+ * expect
+*)
+
+type arg = AString of string | ARest of string | ARest_all of string list
+
+let push acc s =
+ acc := s :: !acc
+
+let f_str acc s = push acc (AString s)
+
+let f_rest acc s = push acc (ARest s)
+
+let f_rest_all acc ss = push acc (ARest_all ss)
+
+let test args =
+ let acc = ref [] in
+ Arg.parse_argv ~current:(ref 0) args Arg.[
+ "-str", String (f_str acc), "String (1)";
+ "-rest", Rest (f_rest acc), "Rest (*)";
+ "-rest-all", Rest_all (f_rest_all acc), "Rest_all (*)";
+ ] failwith "";
+ List.rev !acc
+
+[%%expect{|
+type arg = AString of string | ARest of string | ARest_all of string list
+val push : 'a list ref -> 'a -> unit = <fun>
+val f_str : arg list ref -> string -> unit = <fun>
+val f_rest : arg list ref -> string -> unit = <fun>
+val f_rest_all : arg list ref -> string list -> unit = <fun>
+val test : string array -> arg list = <fun>
+|}];;
+
+let _ = test [|
+ "prog";
+ "-str"; "foo";
+ "-str"; "bar";
+ "-rest";
+ "foobar";
+ "-str"; "foobaz"
+|];;
+[%%expect{|
+- : arg list =
+[AString "foo"; AString "bar"; ARest "foobar"; ARest "-str"; ARest "foobaz"]
+|}];;
+
+let _ = test [|
+ "prog";
+ "-str"; "foo";
+ "-str"; "bar";
+ "-rest-all";
+ "foobar";
+ "-str"; "foobaz"
+|];;
+[%%expect{|
+- : arg list =
+[AString "foo"; AString "bar"; ARest_all ["foobar"; "-str"; "foobaz"]]
+|}];;
+
+(* Rest does nothing when there are no following arguments *)
+let _ = test [|
+ "prog";
+ "-str"; "foo";
+ "-str"; "bar";
+ "-rest";
+|];;
+[%%expect{|
+- : arg list = [AString "foo"; AString "bar"]
+|}];;
+
+(* Rest_all lets us detect that there were no rest arguments *)
+let _ = test [|
+ "prog";
+ "-str"; "foo";
+ "-str"; "bar";
+ "-rest-all";
+|];;
+[%%expect{|
+- : arg list = [AString "foo"; AString "bar"; ARest_all []]
+|}];;
-(* TEST
- compare_programs = "false" (* See https://github.com/ocaml/ocaml/pull/8853 *)
-*)
+(* TEST *)
let current = ref 0;;
(* TEST
* native
- compare_programs = "false"
*)
(** Test that the right message errors are emitted by Arg *)
--- /dev/null
+(* TEST *)
+
+let r = Atomic.make 1
+let () = assert (Atomic.get r = 1)
+
+let () = Atomic.set r 2
+let () = assert (Atomic.get r = 2)
+
+let () = assert (Atomic.exchange r 3 = 2)
+
+let () = assert (Atomic.compare_and_set r 3 4 = true)
+let () = assert (Atomic.get r = 4)
+
+let () = assert (Atomic.compare_and_set r 3 (-4) = false)
+let () = assert (Atomic.get r = 4 )
+
+let () = assert (Atomic.compare_and_set r 3 4 = false)
+
+let () = assert (Atomic.fetch_and_add r 2 = 4)
+let () = assert (Atomic.get r = 6)
+
+let () = assert (Atomic.fetch_and_add r (-2) = 6)
+let () = assert (Atomic.get r = 4)
+
+let () = assert ((Atomic.incr r; Atomic.get r) = 5)
+
+let () = assert ((Atomic.decr r; Atomic.get r) = 4)
+
+let () =
+ let r = Atomic.make 0 in
+ let cur = Atomic.get r in
+ ignore (Atomic.set r (cur + 1), Atomic.set r (cur - 1));
+ assert (Atomic.get r <> cur)
+
+let () =
+ let r = Atomic.make 0 in
+ let cur = Atomic.get r in
+ ignore (Atomic.incr r, Atomic.decr r);
+ assert (Atomic.get r = cur)
** setup-ocamlc.byte-build-env
*** script
-script = "gfortran -c bigarrf.f"
+script = "sh ${test_source_directory}/call-gfortran.sh ${cc} -c bigarrf.f"
**** ocamlc.byte
all_modules = "bigarrf.o bigarrfstub.c bigarrfml.ml"
***** run
** setup-ocamlopt.byte-build-env
*** script
-script = "gfortran -c bigarrf.f"
+script = "sh ${test_source_directory}/call-gfortran.sh ${cc} -c bigarrf.f"
**** ocamlopt.byte
all_modules = "bigarrf.o bigarrfstub.c bigarrfml.ml"
***** run
--- /dev/null
+#!/bin/sh
+
+# This somewhat hackily passes any extra words in CC to gfortran
+# This means for a 32-bit build (configured with CC="gcc -m32" the -m32
+# gets passed to gfortran)
+shift 1
+gfortran "$@"
printf " %d..." test_number
end
+let with_trace f =
+ let events = ref [] in
+ let trace e = events := e :: !events in
+ let v = f trace in
+ (v, List.rev !events)
+
(* One-dimensional arrays *)
(* flambda can cause some of these values not to be reclaimed by the Gc, which
test 7 (Array1.slice a 2) (Array0.of_value int fortran_layout 4);
test 8 (Array1.slice a 3) (Array0.of_value int fortran_layout 3);
+ testing_function "init";
+ let check1 arr graph = List.for_all (fun (i, fi) -> arr.{i} = fi) graph in
+
+ let ba, log = with_trace @@ fun trace ->
+ Array1.init int c_layout 5 (fun x -> trace (x,x); x) in
+ test 1 log [0,0;
+ 1,1;
+ 2,2;
+ 3,3;
+ 4,4];
+ test 2 true (check1 ba log);
+
+ let ba, log = with_trace @@ fun trace ->
+ Array1.init int fortran_layout 5 (fun x -> trace (x,x); x) in
+ test 3 log [1,1;
+ 2,2;
+ 3,3;
+ 4,4;
+ 5,5];
+ test 4 true (check1 ba log);
(* Bi-dimensional arrays *)
test 8 (Array2.slice_right a 3)
(from_list_fortran int [1003;2003;3003;4003;5003]);
+ testing_function "init";
+ let check2 arr graph = List.for_all (fun ((i,j), fij) -> arr.{i,j} = fij) graph in
+
+ let ba, log = with_trace @@ fun trace ->
+ Array2.init int c_layout 4 2
+ (fun x y -> let v = 10*x + y in trace ((x,y),v); v) in
+ test 1 log [(0,0), 00; (0,1), 01;
+ (1,0), 10; (1,1), 11;
+ (2,0), 20; (2,1), 21;
+ (3,0), 30; (3,1), 31];
+ test 2 true (check2 ba log);
+
+ let ba, log = with_trace @@ fun trace ->
+ Array2.init int fortran_layout 4 2
+ (fun x y -> let v = 10*x + y in trace ((x,y),v); v) in
+ test 3 log [(1,1), 11; (2,1), 21; (3,1), 31; (4,1), 41;
+ (1,2), 12; (2,2), 22; (3,2), 32; (4,2), 42];
+ test 4 true (check2 ba log);
+
(* Tri-dimensional arrays *)
print_newline();
test 6 (Array3.slice_right_1 a 1 2) (from_list_fortran int [112;212;312]);
test 7 (Array3.slice_right_1 a 3 1) (from_list_fortran int [131;231;331]);
+ testing_function "init";
+ let check3 arr graph =
+ List.for_all (fun ((i,j,k), fijk) -> arr.{i,j,k} = fijk) graph in
+
+ let ba, log = with_trace @@ fun trace ->
+ Array3.init int c_layout 4 2 3
+ (fun x y z -> let v = 100*x + 10*y + z in trace ((x,y,z),v); v) in
+ test 1 log [(0,0,0), 000; (0,0,1), 001; (0,0,2), 002;
+ (0,1,0), 010; (0,1,1), 011; (0,1,2), 012;
+
+ (1,0,0), 100; (1,0,1), 101; (1,0,2), 102;
+ (1,1,0), 110; (1,1,1), 111; (1,1,2), 112;
+
+ (2,0,0), 200; (2,0,1), 201; (2,0,2), 202;
+ (2,1,0), 210; (2,1,1), 211; (2,1,2), 212;
+
+ (3,0,0), 300; (3,0,1), 301; (3,0,2), 302;
+ (3,1,0), 310; (3,1,1), 311; (3,1,2), 312];
+ test 2 true (check3 ba log);
+
+ let ba, log = with_trace @@ fun trace ->
+ Array3.init int fortran_layout 4 2 3
+ (fun x y z -> let v = 100*x + 10*y + z in trace ((x,y,z), v); v) in
+ test 3 log [(1,1,1), 111; (2,1,1), 211; (3,1,1), 311; (4,1,1), 411;
+ (1,2,1), 121; (2,2,1), 221; (3,2,1), 321; (4,2,1), 421;
+
+ (1,1,2), 112; (2,1,2), 212; (3,1,2), 312; (4,1,2), 412;
+ (1,2,2), 122; (2,2,2), 222; (3,2,2), 322; (4,2,2), 422;
+
+ (1,1,3), 113; (2,1,3), 213; (3,1,3), 313; (4,1,3), 413;
+ (1,2,3), 123; (2,2,3), 223; (3,2,3), 323; (4,2,3), 423];
+ test 4 true (check3 ba log);
+
testing_function "size_in_bytes_general";
let a = Genarray.create int c_layout [|2;2;2;2;2|] in
test 1 (Genarray.size_in_bytes a) (32 * (kind_size_in_bytes int));
+ testing_function "init";
+ let checkgen arr graph =
+ List.for_all (fun (i, fi) -> Genarray.get arr i = fi) graph in
+
+ let ba, log = with_trace @@ fun trace ->
+ Genarray.init int c_layout [|4; 2; 3; 2|]
+ (fun i -> let v = 1000*i.(0) + 100*i.(1) + 10*i.(2) + i.(3) in
+ trace (Array.copy i, v); v) in
+ test 1 log [[|0;0;0;0|], 0000; [|0;0;0;1|], 0001;
+ [|0;0;1;0|], 0010; [|0;0;1;1|], 0011;
+ [|0;0;2;0|], 0020; [|0;0;2;1|], 0021;
+
+ [|0;1;0;0|], 0100; [|0;1;0;1|], 0101;
+ [|0;1;1;0|], 0110; [|0;1;1;1|], 0111;
+ [|0;1;2;0|], 0120; [|0;1;2;1|], 0121;
+
+ [|1;0;0;0|], 1000; [|1;0;0;1|], 1001;
+ [|1;0;1;0|], 1010; [|1;0;1;1|], 1011;
+ [|1;0;2;0|], 1020; [|1;0;2;1|], 1021;
+
+ [|1;1;0;0|], 1100; [|1;1;0;1|], 1101;
+ [|1;1;1;0|], 1110; [|1;1;1;1|], 1111;
+ [|1;1;2;0|], 1120; [|1;1;2;1|], 1121;
+
+ [|2;0;0;0|], 2000; [|2;0;0;1|], 2001;
+ [|2;0;1;0|], 2010; [|2;0;1;1|], 2011;
+ [|2;0;2;0|], 2020; [|2;0;2;1|], 2021;
+
+ [|2;1;0;0|], 2100; [|2;1;0;1|], 2101;
+ [|2;1;1;0|], 2110; [|2;1;1;1|], 2111;
+ [|2;1;2;0|], 2120; [|2;1;2;1|], 2121;
+
+ [|3;0;0;0|], 3000; [|3;0;0;1|], 3001;
+ [|3;0;1;0|], 3010; [|3;0;1;1|], 3011;
+ [|3;0;2;0|], 3020; [|3;0;2;1|], 3021;
+
+ [|3;1;0;0|], 3100; [|3;1;0;1|], 3101;
+ [|3;1;1;0|], 3110; [|3;1;1;1|], 3111;
+ [|3;1;2;0|], 3120; [|3;1;2;1|], 3121;];
+ test 2 true (checkgen ba log);
+
+ let ba, log = with_trace @@ fun trace ->
+ Genarray.init int fortran_layout [|4; 2; 3; 2|]
+ (fun i -> let v = 1000*i.(0) + 100*i.(1) + 10*i.(2) + i.(3) in
+ trace (Array.copy i, v); v) in
+ test 3 log [[|1;1;1;1|], 1111; [|2;1;1;1|], 2111;
+ [|3;1;1;1|], 3111; [|4;1;1;1|], 4111;
+
+ [|1;2;1;1|], 1211; [|2;2;1;1|], 2211;
+ [|3;2;1;1|], 3211; [|4;2;1;1|], 4211;
+
+ [|1;1;2;1|], 1121; [|2;1;2;1|], 2121;
+ [|3;1;2;1|], 3121; [|4;1;2;1|], 4121;
+
+ [|1;2;2;1|], 1221; [|2;2;2;1|], 2221;
+ [|3;2;2;1|], 3221; [|4;2;2;1|], 4221;
+
+ [|1;1;3;1|], 1131; [|2;1;3;1|], 2131;
+ [|3;1;3;1|], 3131; [|4;1;3;1|], 4131;
+
+ [|1;2;3;1|], 1231; [|2;2;3;1|], 2231;
+ [|3;2;3;1|], 3231; [|4;2;3;1|], 4231;
+
+ [|1;1;1;2|], 1112; [|2;1;1;2|], 2112;
+ [|3;1;1;2|], 3112; [|4;1;1;2|], 4112;
+
+ [|1;2;1;2|], 1212; [|2;2;1;2|], 2212;
+ [|3;2;1;2|], 3212; [|4;2;1;2|], 4212;
+
+ [|1;1;2;2|], 1122; [|2;1;2;2|], 2122;
+ [|3;1;2;2|], 3122; [|4;1;2;2|], 4122;
+
+ [|1;2;2;2|], 1222; [|2;2;2;2|], 2222;
+ [|3;2;2;2|], 3222; [|4;2;2;2|], 4222;
+
+ [|1;1;3;2|], 1132; [|2;1;3;2|], 2132;
+ [|3;1;3;2|], 3132; [|4;1;3;2|], 4132;
+
+ [|1;2;3;2|], 1232; [|2;2;3;2|], 2232;
+ [|3;2;3;2|], 3232; [|4;2;3;2|], 4232];
+ test 4 true (checkgen ba log);
+
(* Zero-dimensional arrays *)
testing_function "------ Array0 --------";
testing_function "create/set/get";
{im=0.5;re= -2.0}, {im=0.5;re= -2.0};
{im=3.1415;re=1.2345678}, {im=3.1415;re=1.2345678}]);
+ testing_function "init";
+ let ba = Array0.init int c_layout 10 in
+ test 1 ba (Array0.of_value int c_layout 10);
+
+ let ba = Array0.init int fortran_layout 10 in
+ test 2 ba (Array0.of_value int fortran_layout 10);
(* Kind size *)
testing_function "kind_size_in_bytes";
test 9 (Genarray.get c [|0|]) 3;
test 10 (Genarray.get (Genarray.slice_left c [|0|]) [||]) 3;
-(* I/O *)
+ (* I/O *)
print_newline();
testing_function "------ I/O --------";
1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12...
slice
1... 2... 3... 6... 7... 8...
+init
+ 1... 2... 3... 4...
------ Array2 --------
1... 2...
slice
1... 2... 3... 4... 5... 6... 7... 8...
+init
+ 1... 2... 3... 4...
------ Array3 --------
1...
slice1
1... 2... 3... 4... 5... 6... 7...
+init
+ 1... 2... 3... 4...
size_in_bytes_general
1...
+init
+ 1... 2... 3... 4...
------ Array0 --------
create/set/get
1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12...
+init
+ 1... 2...
kind_size_in_bytes
1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... 13...
-(* TEST
- compare_programs = "false" (* See https://github.com/ocaml/ocaml/pull/8853 *)
-*)
+(* TEST *)
(** Test the various change_layout for Genarray and the various Array[n] *)
--- /dev/null
+(* TEST *)
+
+let len = 15000
+let rounds = 10
+
+let () =
+ let oc = open_out "data.txt" in
+ for i = 1 to rounds do
+ Printf.fprintf oc "%s\n%!" (String.make len 'x');
+ done;
+ close_out oc;
+ let ic = open_in "data.txt" in
+ let l1 = in_channel_length ic in
+ for i = 1 to rounds do
+ let s = input_line ic in
+ assert (String.length s = len);
+ let l = in_channel_length ic in
+ assert (l = l1)
+ done;
+ close_in ic
--- /dev/null
+(* TEST *)
+
+let () =
+ let oc = open_out_bin "data.txt" in
+ output_string oc "0\r\n1\r\n";
+ close_out oc;
+ (* Open in text mode to trigger EOL conversion under Windows *)
+ let ic = open_in "data.txt" in
+ ignore (input_line ic);
+ seek_in ic 3;
+ (* Normally we should be looking at "1\r\n", which will be read as
+ "1" under Windows because of EOL conversion and "1\r" otherwise.
+ What goes wrong with the old implementation of seek_in is that
+ we have "0\n\1\n" in the channel buffer and have read "0\n" already,
+ so we think we are at position 2, and the seek to position 3
+ just advances by one in the buffer, pointing to "\n" instead of "1\n". *)
+ let l = input_line ic in
+ close_in ic;
+ assert (l = "1" || l = "1\r")
#include "caml/alloc.h"
#include <stdio.h>
-extern value stub1(void);
+CAMLextern value stub1(void);
value stub2(void) {
printf("This is stub2, calling stub1:\n"); fflush(stdout);
--- /dev/null
+(* TEST
+ include dynlink
+*)
+
+(* Make sure dynlink state info is accurate before any load
+ occurs #9338. *)
+
+let test () =
+ assert (List.mem "Dynlink" (Dynlink.main_program_units ()));
+ assert (List.mem "Dynlink" (Dynlink.all_units ()));
+ ()
+
+let () = test (); print_endline "OK"
Called from Test10_plugin in file "test10_plugin.ml", line 10, characters 2-6
Called from Dynlink.Bytecode.run in file "otherlibs/dynlink/dynlink.ml", line 137, characters 16-25
Re-raised at Dynlink.Bytecode.run in file "otherlibs/dynlink/dynlink.ml", line 139, characters 6-137
-Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 344, characters 13-44
+Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 347, characters 13-44
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 342, characters 8-240
-Re-raised at Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 352, characters 8-17
+Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 345, characters 8-240
+Re-raised at Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 355, characters 8-17
Called from Test10_main in file "test10_main.ml", line 51, characters 13-69
Called from Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 85, characters 12-29
Re-raised at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 87, characters 10-149
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 344, characters 13-44
+Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 347, characters 13-44
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 342, characters 8-240
-Re-raised at Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 352, characters 8-17
-Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 354, characters 26-45
+Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 345, characters 8-240
+Re-raised at Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 355, characters 8-17
+Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 357, characters 26-45
Called from Test10_main in file "test10_main.ml", line 49, characters 30-87
--- /dev/null
+(* TEST
+ * expect
+*)
+
+open Either;;
+
+[left 1; right true];;
+[%%expect {|
+- : (int, bool) Either.t list = [Left 1; Right true]
+|}];;
+
+List.map is_left [left 1; right true];;
+[%%expect {|
+- : bool list = [true; false]
+|}];;
+
+List.map is_right [left 1; right true];;
+[%%expect {|
+- : bool list = [false; true]
+|}];;
+
+[find_left (Left 1); find_left (Right 1)];;
+[%%expect {|
+- : int option list = [Some 1; None]
+|}];;
+
+[find_right (Left 1); find_right (Right 1)];;
+[%%expect {|
+- : int option list = [None; Some 1]
+|}];;
+
+[map_left succ (Left 1); map_left succ (Right true)];;
+[%%expect {|
+- : (int, bool) Either.t list = [Left 2; Right true]
+|}];;
+
+[map_right succ (Left ()); map_right succ (Right 2)];;
+[%%expect {|
+- : (unit, int) Either.t list = [Left (); Right 3]
+|}];;
+
+[map succ not (Left 1); map succ not (Right true)];;
+[%%expect {|
+- : (int, bool) Either.t list = [Left 2; Right false]
+|}];;
+
+[fold ~left:succ ~right:int_of_string (Left 1);
+ fold ~left:succ ~right:int_of_string (Right "2")];;
+[%%expect {|
+- : int list = [2; 2]
+|}];;
+
+let li = ref [] in
+let add to_str x = li := to_str x :: !li in
+iter ~left:(add Fun.id) ~right:(add string_of_int) (Left "foo");
+iter ~left:(add Fun.id) ~right:(add string_of_int) (Right 2);
+List.rev !li;;
+[%%expect {|
+- : string list = ["foo"; "2"]
+|}];;
+
+(
+ for_all ~left:((=) 1) ~right:((=) "foo") (Left 1),
+ for_all ~left:((=) 1) ~right:((=) "foo") (Right "foo"),
+ for_all ~left:((=) 1) ~right:((=) "foo") (Left 2),
+ for_all ~left:((=) 1) ~right:((=) "foo") (Right "bar")
+);;
+[%%expect {|
+- : bool * bool * bool * bool = (true, true, false, false)
+|}];;
+
+equal ~left:(=) ~right:(=) (Left 1) (Left 1),
+equal ~left:(=) ~right:(=) (Right true) (Right true);;
+[%%expect {|
+- : bool * bool = (true, true)
+|}];;
+
+(equal ~left:(=) ~right:(=) (Left 1) (Left 2),
+ equal ~left:(=) ~right:(=) (Right true) (Right false),
+ equal ~left:(=) ~right:(=) (Left 1) (Right true),
+ equal ~left:(=) ~right:(=) (Right 1) (Left true));;
+[%%expect {|
+- : bool * bool * bool * bool = (false, false, false, false)
+|}];;
+
+equal ~left:(fun _ _ -> false) ~right:(=) (Left 1) (Left 1),
+equal ~left:(=) ~right:(fun _ _ -> false) (Right true) (Right true);;
+[%%expect {|
+- : bool * bool = (false, false)
+|}];;
+
+let cmp = Stdlib.compare in
+(
+ (compare ~left:cmp ~right:cmp (Left 0) (Left 1),
+ compare ~left:cmp ~right:cmp (Left 1) (Left 1),
+ compare ~left:cmp ~right:cmp (Left 1) (Left 0)),
+
+ (compare ~left:cmp ~right:cmp (Right 0) (Right 1),
+ compare ~left:cmp ~right:cmp (Right 1) (Right 1),
+ compare ~left:cmp ~right:cmp (Right 1) (Right 0)),
+
+ (compare ~left:cmp ~right:cmp (Left 1) (Right true),
+ compare ~left:cmp ~right:cmp (Right 1) (Left true))
+);;
+[%%expect {|
+- : (int * int * int) * (int * int * int) * (int * int) =
+((-1, 0, 1), (-1, 0, 1), (-1, 1))
+|}];;
val map_from_array : ('a -> float) -> 'a array -> t
val unsafe_get : t -> int -> float
val unsafe_set : t -> int -> float -> unit
+
+ (* From Sys, rather than Float.Array *)
+ val max_length : int
+end
+
+module Flat_float_array : S = struct
+ include Stdlib.Float.Array
+ let max_length = Sys.max_floatarray_length
end
(* module [Array] specialized to [float] and with a few changes,
let map_from_array f a = map f a
let mem_ieee x a = exists ((=) x) a
type t = float array
+ let max_length = Sys.max_array_length
end
module Test (A : S) : sig end = struct
check_inval (fun i -> A.set a i 1.0) (-1);
check_inval (fun i -> A.set a i 1.0) 1000;
check_inval A.create (-1);
- check_inval A.create (Sys.max_floatarray_length + 1);
+ check_inval A.create (A.max_length + 1);
check_inval (fun i -> A.make i 1.0) (-1);
- check_inval (fun i -> A.make i 1.0) (Sys.max_floatarray_length + 1);
+ check_inval (fun i -> A.make i 1.0) (A.max_length + 1);
(* [length] *)
let test_length l = assert (l = (A.length (A.create l))) in
let a = A.init 1000 Float.of_int in
check_i a;
check_inval (fun i -> A.init i Float.of_int) (-1);
- check_inval (fun i -> A.init i Float.of_int) (Sys.max_floatarray_length + 1);
+ check_inval (fun i -> A.init i Float.of_int) (A.max_length + 1);
(* [append] *)
let check m n =
check_inval (A.blit a 0 a (-1)) 0;
check_inval (A.blit a 0 a 100) 1;
check_inval (A.blit a 0 a 101) 0;
+ let test_blit_overlap a ofs1 ofs2 len =
+ let a = A.of_list a in
+ let b = A.copy a in
+ A.blit a ofs1 a ofs2 len;
+ for i = 0 to len - 1 do
+ assert (A.get b (ofs1 + i) = A.get a (ofs2 + i))
+ done
+ in
+ test_blit_overlap [1.; 2.; 3.; 4.] 1 2 2;
(* [to_list] [of_list] *)
let a = A.init 1000 Float.of_int in
end
(* We run the same tests on [Float.Array] and [Array]. *)
-module T1 = Test (Stdlib.Float.Array)
+module T1 = Test (Flat_float_array)
module T2 = Test (Float_array)
--- /dev/null
+(* TEST
+ include testing
+*)
+
+(*
+
+A test file for the Format module.
+
+*)
+
+open Testing;;
+open Format;;
+
+let say s = Printf.printf s;;
+
+let pp_print_intseq = pp_print_seq ~pp_sep:(fun fmt () -> pp_print_char fmt ' ') pp_print_int;;
+
+try
+
+ say "empty\n%!";
+ test (asprintf "%a%!" pp_print_intseq Seq.empty = "");
+
+ say "\nmisc\n%!";
+ test (asprintf "%a" pp_print_intseq (List.to_seq [0]) = "0");
+ test (asprintf "%a" pp_print_intseq (List.to_seq [0;1;2]) = "0 1 2");
+ test (asprintf "%a" pp_print_intseq (List.to_seq [0;0]) = "0 0");
+
+ say "\nend of tests\n%!";
+
+with e ->
+ say "unexpected exception: %s\n%!" (Printexc.to_string e);
+ test false;
+;;
--- /dev/null
+empty
+ 0
+misc
+ 1 2 3
+end of tests
+
+All tests succeeded.
--- /dev/null
+(* TEST
+*)
+
+let check_contents (h: (string, int) Hashtbl.t)
+ (expected: (string * int) list) =
+ List.iter
+ (fun (k, v) -> assert (Hashtbl.find_opt h k = Some v))
+ expected;
+ List.iter
+ (fun k -> assert (Hashtbl.find_opt h k = None))
+ [""; "n"; "no"; "non"; "none"];
+ Hashtbl.iter
+ (fun k v -> assert (List.assoc_opt k expected = Some v))
+ h
+
+let check_failure (h: (string, int) Hashtbl.t) =
+ try
+ ignore (Hashtbl.find_opt h ""); assert false
+ with Invalid_argument _ ->
+ ()
+
+let check_table supported h expected =
+ if supported
+ then check_contents h expected
+ else check_failure h;
+ check_contents (Hashtbl.rebuild h) expected
+
+(* Hash table version 1, produced with OCaml 3.12.1 *)
+let h1 : (string, int) Hashtbl.t =
+ Marshal.from_string
+ "\132\149\166\190\000\000\000/\000\000\000\n\000\000\000+\000\000\000)\
+ \160D\b\000\0004\000@@@@@\176%threeC@@@@\176#twoB@@@\176$fourD\176#oneA@"
+ 0
+
+(* Hash table version 2, produced with OCaml 4.09.0 *)
+let h2 : (string, int) Hashtbl.t =
+ Marshal.from_string
+ "\132\149\166\190\000\000\000;\000\000\000\012\000\000\0008\000\000\0004\
+ \192E\b\000\000@\000@@@@@@@@@\176$septG\176#sixF@\176$cinqE@\176$neufI\
+ \176$huitH@@@@@@P"
+ 0
+
+let _ =
+ check_table false h1 ["one", 1; "two", 2; "three", 3; "four", 4];
+ check_table true h2 ["cinq", 5; "six", 6; "sept", 7; "huit", 8; "neuf", 9]
let h = Hashtbl.create 16 in
for i = 1 to 1000 do Hashtbl.add h i (i * 2) done;
Printf.printf "%i elements\n" (Hashtbl.length h);
+ let () =
+ (* Check that filter_map_inplace of nothing changes nothing *)
+ let marshaled_before = Marshal.to_string h [Marshal.No_sharing] in
+ Hashtbl.filter_map_inplace (fun _k v -> Some v) h;
+ let marshaled_after = Marshal.to_string h [Marshal.No_sharing] in
+ assert (marshaled_before = marshaled_after) in
Hashtbl.filter_map_inplace (fun k v ->
if k mod 100 = 0 then ((*Hashtbl.add h v v;*) Some (v / 100)) else None)
h;
(* TEST
*)
+let is_even x = (x mod 2 = 0)
+
let string_of_even_opt x =
- if x mod 2 = 0 then
+ if is_even x then
Some (string_of_int x)
else
None
+let string_of_even_or_int x =
+ if is_even x then
+ Either.Left (string_of_int x)
+ else
+ Either.Right x
+
(* Standard test case *)
let () =
let l = List.init 10 (fun x -> x) in
assert (not (List.exists (fun a -> a > 9) l));
assert (List.exists (fun _ -> true) l);
+ assert (List.equal (=) [1; 2; 3] [1; 2; 3]);
+ assert (not (List.equal (=) [1; 2; 3] [1; 2]));
+ assert (not (List.equal (=) [1; 2; 3] [1; 3; 2]));
+
+ (* The current implementation of List.equal calls the comparison
+ function even for different-size lists. This is not part of the
+ specification, so it would be valid to change this behavior, but
+ we don't want to change it without noticing so here is a test for
+ it. *)
+ assert (let c = ref 0 in
+ not (List.equal (fun _ _ -> incr c; true) [1; 2] [1; 2; 3])
+ && !c = 2);
+
+ assert (List.compare compare [1; 2; 3] [1; 2; 3] = 0);
+ assert (List.compare compare [1; 2; 3] [1; 2] > 0);
+ assert (List.compare compare [1; 2; 3] [1; 3; 2] < 0);
+ assert (List.compare compare [3] [2; 1] > 0);
+
begin
let f ~limit a = if a >= limit then Some (a, limit) else None in
assert (List.find_map (f ~limit:3) [] = None);
assert (List.filteri (fun i _ -> i < 2) (List.rev l) = [9; 8]);
+ assert (List.partition is_even [1; 2; 3; 4; 5]
+ = ([2; 4], [1; 3; 5]));
+ assert (List.partition_map string_of_even_or_int [1; 2; 3; 4; 5]
+ = (["2"; "4"], [1; 3; 5]));
+
assert (List.compare_lengths [] [] = 0);
assert (List.compare_lengths [1;2] ['a';'b'] = 0);
assert (List.compare_lengths [] [1;2] < 0);
let s = Marshal.to_bytes (G(A, G(B 2, G(C 3.14, G(D "glop", E 'e'))))) [] in
test 300 (Marshal.header_size + Marshal.data_size s 0 = Bytes.length s)
-external marshal_to_block
- : string -> int -> 'a -> Marshal.extern_flags list -> unit
- = "marshal_to_block"
-external marshal_from_block : string -> int -> 'a = "marshal_from_block"
-external static_alloc : int -> string = "caml_static_alloc"
+external marshal_to_block : int -> 'a -> Marshal.extern_flags list -> unit
+ = "marshal_to_block"
+external marshal_from_block : int -> 'a = "marshal_from_block"
let test_block () =
- let s = static_alloc 512 in
- marshal_to_block s 512 1 [];
- test 401 (marshal_from_block s 512 = 1);
- marshal_to_block s 512 (-1) [];
- test 402 (marshal_from_block s 512 = (-1));
- marshal_to_block s 512 258 [];
- test 403 (marshal_from_block s 512 = 258);
- marshal_to_block s 512 20000 [];
- test 404 (marshal_from_block s 512 = 20000);
- marshal_to_block s 512 0x12345678 [];
- test 405 (marshal_from_block s 512 = 0x12345678);
- marshal_to_block s 512 bigint [];
- test 406 (marshal_from_block s 512 = bigint);
- marshal_to_block s 512 "foobargeebuz" [];
- test 407 (marshal_from_block s 512 = "foobargeebuz");
- marshal_to_block s 512 longstring [];
- test 408 (marshal_from_block s 512 = longstring);
+ marshal_to_block 512 1 [];
+ test 401 (marshal_from_block 512 = 1);
+ marshal_to_block 512 (-1) [];
+ test 402 (marshal_from_block 512 = (-1));
+ marshal_to_block 512 258 [];
+ test 403 (marshal_from_block 512 = 258);
+ marshal_to_block 512 20000 [];
+ test 404 (marshal_from_block 512 = 20000);
+ marshal_to_block 512 0x12345678 [];
+ test 405 (marshal_from_block 512 = 0x12345678);
+ marshal_to_block 512 bigint [];
+ test 406 (marshal_from_block 512 = bigint);
+ marshal_to_block 512 "foobargeebuz" [];
+ test 407 (marshal_from_block 512 = "foobargeebuz");
+ marshal_to_block 512 longstring [];
+ test 408 (marshal_from_block 512 = longstring);
test 409
- (try marshal_to_block s 512 verylongstring []; false
+ (try marshal_to_block 512 verylongstring []; false
with Failure s when s = "Marshal.to_buffer: buffer overflow" -> true);
- marshal_to_block s 512 3.141592654 [];
- test 410 (marshal_from_block s 512 = 3.141592654);
- marshal_to_block s 512 () [];
- test 411 (marshal_from_block s 512 = ());
- marshal_to_block s 512 A [];
- test 412 (match marshal_from_block s 512 with
+ marshal_to_block 512 3.141592654 [];
+ test 410 (marshal_from_block 512 = 3.141592654);
+ marshal_to_block 512 () [];
+ test 411 (marshal_from_block 512 = ());
+ marshal_to_block 512 A [];
+ test 412 (match marshal_from_block 512 with
A -> true
| _ -> false);
- marshal_to_block s 512 (B 1) [];
- test 413 (match marshal_from_block s 512 with
+ marshal_to_block 512 (B 1) [];
+ test 413 (match marshal_from_block 512 with
(B 1) -> true
| _ -> false);
- marshal_to_block s 512 (C 2.718) [];
- test 414 (match marshal_from_block s 512 with
+ marshal_to_block 512 (C 2.718) [];
+ test 414 (match marshal_from_block 512 with
(C f) -> f = 2.718
| _ -> false);
- marshal_to_block s 512 (D "hello, world!") [];
- test 415 (match marshal_from_block s 512 with
+ marshal_to_block 512 (D "hello, world!") [];
+ test 415 (match marshal_from_block 512 with
(D "hello, world!") -> true
| _ -> false);
- marshal_to_block s 512 (E 'l') [];
- test 416 (match marshal_from_block s 512 with
+ marshal_to_block 512 (E 'l') [];
+ test 416 (match marshal_from_block 512 with
(E 'l') -> true
| _ -> false);
- marshal_to_block s 512 (F(B 1)) [];
- test 417 (match marshal_from_block s 512 with
+ marshal_to_block 512 (F(B 1)) [];
+ test 417 (match marshal_from_block 512 with
(F(B 1)) -> true
| _ -> false);
- marshal_to_block s 512 (G(A, G(B 2, G(C 3.14, G(D "glop", E 'e'))))) [];
- test 418 (match marshal_from_block s 512 with
+ marshal_to_block 512 (G(A, G(B 2, G(C 3.14, G(D "glop", E 'e'))))) [];
+ test 418 (match marshal_from_block 512 with
(G(A, G(B 2, G(C 3.14, G(D "glop", E 'e'))))) -> true
| _ -> false);
- marshal_to_block s 512 (H(1, A)) [];
- test 419 (match marshal_from_block s 512 with
+ marshal_to_block 512 (H(1, A)) [];
+ test 419 (match marshal_from_block 512 with
(H(1, A)) -> true
| _ -> false);
- marshal_to_block s 512 (I(B 2, 1e-6)) [];
- test 420 (match marshal_from_block s 512 with
+ marshal_to_block 512 (I(B 2, 1e-6)) [];
+ test 420 (match marshal_from_block 512 with
(I(B 2, 1e-6)) -> true
| _ -> false);
let x = D "sharing" in
let y = G(x, x) in
let z = G(y, G(x, y)) in
- marshal_to_block s 512 z [];
- test 421 (match marshal_from_block s 512 with
+ marshal_to_block 512 z [];
+ test 421 (match marshal_from_block 512 with
G((G((D "sharing" as t1), t2) as t3), G(t4, t5)) ->
t1 == t2 && t3 == t5 && t4 == t1
| _ -> false);
- marshal_to_block s 512 [|1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16|] [];
- test 422 (marshal_from_block s 512 =
+ marshal_to_block 512 [|1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16|] [];
+ test 422 (marshal_from_block 512 =
[|1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16|]);
let rec big n = if n <= 0 then A else H(n, big(n-1)) in
test 423
- (try marshal_to_block s 512 (big 1000) []; false
+ (try marshal_to_block 512 (big 1000) []; false
with Failure _ -> true);
test 424
- (try marshal_to_block s 512 "Hello, world!" [];
- ignore (marshal_from_block s 8);
+ (try marshal_to_block 512 "Hello, world!" [];
+ ignore (marshal_from_block 8);
false
with Failure _ -> true)
#define CAML_INTERNALS
-value marshal_to_block(value vbuf, value vlen, value v, value vflags)
+#define BLOCK_SIZE 512
+static char marshal_block[BLOCK_SIZE];
+
+value marshal_to_block(value vlen, value v, value vflags)
{
- return Val_long(caml_output_value_to_block(v, vflags,
- (char *) vbuf, Long_val(vlen)));
+ CAMLassert(Long_val(vlen) <= BLOCK_SIZE);
+ caml_output_value_to_block(v, vflags, marshal_block, Long_val(vlen));
+ return Val_unit;
}
-value marshal_from_block(value vbuf, value vlen)
+value marshal_from_block(value vlen)
{
- return caml_input_value_from_block((char *) vbuf, Long_val(vlen));
+ CAMLassert(Long_val(vlen) <= BLOCK_SIZE);
+ return caml_input_value_from_block(marshal_block, Long_val(vlen));
}
static void bad_serialize(value v, uintnat* sz_32, uintnat* sz_64)
--- /dev/null
+(* TEST
+*)
+
+let _ =
+
+ begin match Obj.new_block 255 1 with
+ | v -> failwith "Expected failure for custom block"
+ | exception (Invalid_argument _) -> ()
+ end;
+
+ begin match Obj.new_block 252 0 with
+ | v -> failwith "Expected failure for zero length string block"
+ | exception (Invalid_argument _) -> ()
+ end;
+
+ print_endline "OK"
(* TEST
*)
-let native =
- match Sys.backend_type with
- | Sys.Native -> true
- | Sys.Bytecode -> false
- | Sys.Other s -> print_endline s; assert false
let size x = Obj.reachable_words (Obj.repr x)
let f () =
let x = Random.int 10 in
expect_size 0 42;
- expect_size (if native then 0 else 3) (1, 2);
expect_size 2 [| x |];
expect_size 3 [| x; 0 |];
--- /dev/null
+(* TEST
+ * naked_pointers
+ ** bytecode
+ ** native
+*)
+
+let native =
+ match Sys.backend_type with
+ | Sys.Native -> true
+ | Sys.Bytecode -> false
+ | Sys.Other s -> print_endline s; assert false
+
+let size x = Obj.reachable_words (Obj.repr x)
+
+let expect_size s x =
+ let i = size x in
+ if i <> s then
+ Printf.printf "size = %i; expected = %i\n%!" i s
+
+let () =
+ expect_size (if native then 0 else 3) (1, 2)
(* Test that two Random.self_init() in close succession will not result
in the same PRNG state.
Note that even when the code is correct this test is expected to fail
- once in 10000 runs.
+ once in 2^30 runs.
*)
let () =
Random.self_init ();
- let x = Random.int 10000 in
+ let x = Random.bits () in
Random.self_init ();
- let y = Random.int 10000 in
+ let y = Random.bits () in
if x = y then print_endline "FAILED" else print_endline "PASSED"
(* TEST
include testing
- compare_programs = "false" (* See https://github.com/ocaml/ocaml/pull/8853 *)
*)
(*
checkbool "to_seq_of_seq"
(M.equal (=) s1 (M.of_seq @@ M.to_seq s1));
+ checkbool "to_rev_seq_of_seq"
+ (M.equal (=) s1 (M.of_seq @@ M.to_rev_seq s1));
+
checkbool "to_seq_from"
(let seq = M.to_seq_from x s1 in
let ok1 = List.of_seq seq |> List.for_all (fun (y,_) -> y >= x) in
in
ok1 && ok2);
+ checkbool "to_seq_increasing"
+ (let seq = M.to_seq s1 in
+ let last = ref min_int in
+ Seq.iter (fun (x, _) -> assert (!last <= x); last := x) seq;
+ true);
+
+ checkbool "to_rev_seq_decreasing"
+ (let seq = M.to_rev_seq s1 in
+ let last = ref max_int in
+ Seq.iter (fun (x, _) -> assert (x <= !last); last := x) seq;
+ true);
+
()
let rkey() = Random.int 10
checkbool "to_seq_of_seq"
(S.equal s1 (S.of_seq @@ S.to_seq s1));
+ checkbool "to_seq_of_seq"
+ (S.equal s1 (S.of_seq @@ S.to_rev_seq s1));
+
checkbool "to_seq_from"
(let seq = S.to_seq_from x s1 in
let ok1 = List.of_seq seq |> List.for_all (fun y -> y >= x) in
in
ok1 && ok2);
+ checkbool "to_seq_increasing"
+ (let seq = S.to_seq s1 in
+ let last = ref min_int in
+ Seq.iter (fun x -> assert (!last <= x); last := x) seq;
+ true);
+
+ checkbool "to_rev_seq_decreasing"
+ (let seq = S.to_rev_seq s1 in
+ let last = ref max_int in
+ Seq.iter (fun x -> assert (x <= !last); last := x) seq;
+ true);
+
()
let relt() = Random.int 10
module Se : module type of struct include Set end [@remove_aliases] =
MoreLabels.Set
-
-(* For *)
-(* module H : module type of Hashtbl = MoreLabels.Hashtbl *)
-(* we will have following error: *)
-(* Error: Signature mismatch: *)
-(* ... *)
-(* Type declarations do not match: *)
-(* type statistics = Hashtbl.statistics *)
-(* is not included in *)
-(* type statistics = { *)
-(* num_bindings : int; *)
-(* num_buckets : int; *)
-(* max_bucket_length : int; *)
-(* bucket_histogram : int array; *)
-(* } *)
-(* Their kinds differ. *)
-(* This is workaround:*)
-module Indirection = struct
- type t = Hashtbl.statistics = { num_bindings: int;
- num_buckets: int;
- max_bucket_length: int;
- bucket_histogram: int array}
-end
-module type HS = sig
- type statistics = Indirection.t
- include module type of struct include Hashtbl end [@remove_aliases]
- with type statistics := Indirection.t
-end
-module H : HS = MoreLabels.Hashtbl
+module H : module type of struct include Hashtbl end [@remove_aliases] =
+ MoreLabels.Hashtbl
let () =
()
while !sz >= 0 do push big l; sz += Sys.max_string_length done;
while !sz <= 0 do push big l; sz += Sys.max_string_length done;
try ignore (String.concat "" !l); assert false
- with Invalid_argument _ -> ()
+ with Invalid_argument _ -> ();
end
--- /dev/null
+(* TEST
+
+* hassysthreads
+include systhreads
+** not-windows
+*** bytecode
+*** native
+*)
+
+let signals_requested = Atomic.make 0
+let signal_delay = 0.1
+let _ = Thread.create (fun () ->
+ let signals_sent = ref 0 in
+ ignore (Thread.sigmask Unix.SIG_BLOCK [Sys.sigint]);
+ while true do
+ if Atomic.get signals_requested > !signals_sent then begin
+ Thread.delay signal_delay;
+ Unix.kill (Unix.getpid ()) Sys.sigint;
+ incr signals_sent
+ end else begin
+ Thread.yield ()
+ end
+ done) ()
+let request_signal () = Atomic.incr signals_requested
+
+let () =
+ let (rd, wr) = Unix.pipe () in
+ Sys.catch_break true;
+ request_signal ();
+ begin match Unix.read rd (Bytes.make 1 'a') 0 1 with
+ | _ -> assert false
+ | exception Sys.Break -> print_endline "break: ok" end;
+ Sys.catch_break false;
+ Unix.close rd;
+ Unix.close wr
+
+let () =
+ let (rd, wr) = Unix.pipe () in
+ Sys.set_signal Sys.sigint (Signal_handle (fun _ -> Gc.full_major ()));
+ request_signal ();
+ begin match Unix.read rd (Bytes.make 1 'a') 0 1 with
+ | _ -> assert false
+ | exception Unix.Unix_error(Unix.EINTR, "read", _) ->
+ print_endline "eintr: ok" end;
+ Sys.set_signal Sys.sigint Signal_default;
+ Unix.close rd;
+ Unix.close wr
+
+
+(* Doing I/O on stdout would be more realistic, but seeking has the
+ same locking & scheduling effects, without actually producing any
+ output *)
+let poke_stdout () =
+ match out_channel_length stdout with
+ | _ -> ()
+ | exception Sys_error _ -> ()
+
+let () =
+ let r = Atomic.make true in
+ Sys.set_signal Sys.sigint (Signal_handle (fun _ ->
+ poke_stdout (); Atomic.set r false));
+ request_signal ();
+ while Atomic.get r do
+ poke_stdout ()
+ done;
+ Sys.set_signal Sys.sigint Signal_default;
+ print_endline "chan: ok"
+
+let () =
+ let mklist () = List.init 1000 (fun i -> (i, i)) in
+ let before = Sys.opaque_identity (ref (mklist ())) in
+ let during = Atomic.make (Sys.opaque_identity (mklist ())) in
+ let siglist = ref [] in
+ Sys.set_signal Sys.sigint (Signal_handle (fun _ ->
+ Gc.full_major (); poke_stdout (); Gc.compact ();
+ siglist := mklist ();
+ raise Sys.Break));
+ request_signal ();
+ begin match
+ while true do
+ poke_stdout ();
+ Atomic.set during (mklist ())
+ done
+ with
+ | () -> assert false
+ | exception Sys.Break -> () end;
+ let expected = Sys.opaque_identity (mklist ()) in
+ assert (!before = expected);
+ assert (Atomic.get during = expected);
+ assert (!siglist = expected);
+ print_endline "gc: ok"
--- /dev/null
+break: ok
+eintr: ok
+chan: ok
+gc: ok
let cons = Thread.create consumer (ipipe, oc) in
Thread.join prod;
Thread.join cons;
- if Unix.system ("cmp " ^ src ^ " " ^ dst) = Unix.WEXITED 0
+ if Sys.command ("cmp " ^ src ^ " " ^ dst) = 0
then print_string "passed"
else print_string "FAILED";
print_newline()
--- /dev/null
+(* TEST
+
+* hassysthreads
+include systhreads
+** bytecode
+** native
+
+*)
+
+let log s =
+ Printf.printf "%s\n%!" s
+
+let mutex_lock_must_fail m =
+ try
+ Mutex.lock m; log "Should have failed!"
+ with Sys_error _ ->
+ log "Error reported"
+
+let mutex_unlock_must_fail m =
+ try
+ Mutex.unlock m; log "Should have failed!"
+ with Sys_error _ ->
+ log "Error reported"
+
+let mutex_deadlock () =
+ let m = Mutex.create() in
+ log "Acquiring mutex";
+ Mutex.lock m;
+ log "Acquiring mutex again";
+ mutex_lock_must_fail m;
+ log "Releasing mutex";
+ Mutex.unlock m;
+ let f () =
+ log "Acquiring mutex from another thread";
+ Mutex.lock m;
+ log "Success";
+ Mutex.unlock m in
+ Thread.join (Thread.create f ())
+
+let mutex_unlock_twice () =
+ let m = Mutex.create() in
+ log "Acquiring mutex";
+ Mutex.lock m;
+ log "Releasing mutex";
+ Mutex.unlock m;
+ log "Releasing mutex again";
+ mutex_unlock_must_fail m;
+ log "Releasing mutex one more time";
+ mutex_unlock_must_fail m
+
+let mutex_unlock_other_thread () =
+ let m = Mutex.create() in
+ log "Acquiring mutex";
+ Mutex.lock m;
+ let f () =
+ log "Releasing mutex from another thread";
+ mutex_unlock_must_fail m;
+ log "Releasing mutex from another thread (again)";
+ mutex_unlock_must_fail m in
+ Thread.join (Thread.create f ())
+
+let _ =
+ log "---- Self deadlock";
+ mutex_deadlock();
+ log "---- Unlock twice";
+ mutex_unlock_twice();
+ log "---- Unlock in other thread";
+ mutex_unlock_other_thread()
--- /dev/null
+---- Self deadlock
+Acquiring mutex
+Acquiring mutex again
+Error reported
+Releasing mutex
+Acquiring mutex from another thread
+Success
+---- Unlock twice
+Acquiring mutex
+Releasing mutex
+Releasing mutex again
+Error reported
+Releasing mutex one more time
+Error reported
+---- Unlock in other thread
+Acquiring mutex
+Releasing mutex from another thread
+Error reported
+Releasing mutex from another thread (again)
+Error reported
* hassysthreads
include systhreads
** native
- compare_programs = "false"
-
*)
open Printf
--- /dev/null
+(* TEST
+
+* hassysthreads
+include systhreads
+** bytecode
+** native
+
+*)
+
+let t =
+ let t = Thread.create (fun _ -> ())() in
+ Thread.join t
+
+let () =
+ Thread.exit ()
let _ =
(* Files *)
begin
- let fd = Unix.(openfile "file.tmp" [O_WRONLY;O_CREAT;O_TRUNC] 0o666) in
+ let fd = Unix.(openfile "file.tmp"
+ [O_WRONLY;O_CREAT;O_TRUNC;O_SHARE_DELETE] 0o666) in
shouldpass "File 1" Unix.in_channel_of_descr fd;
shouldpass "File 2" Unix.out_channel_of_descr fd;
Unix.close fd
end;
(* A closed file descriptor should now fail *)
begin
- let fd = Unix.(openfile "file.tmp" [O_WRONLY;O_CREAT;O_TRUNC] 0o666) in
+ let fd = Unix.(openfile "file.tmp"
+ [O_WRONLY;O_CREAT;O_TRUNC;O_SHARE_DELETE] 0o666) in
Unix.close fd;
shouldfail "Closed file 1" Unix.in_channel_of_descr fd;
shouldfail "Closed file 2" Unix.out_channel_of_descr fd
if status <> Unix.WEXITED 0 then
out Unix.stdout "!!! reflector exited with an error\n"
+let test_12tofile () = (* > file 2>&1 *)
+ let f =
+ Unix.(openfile "./tmpout.txt" [O_WRONLY;O_TRUNC;O_CREAT;O_CLOEXEC] 0o600) in
+ let pid =
+ Unix.create_process
+ refl
+ [| refl; "-o"; "123"; "-e"; "456"; "-o"; "789" |]
+ Unix.stdin f f in
+ let (_, status) = Unix.waitpid [] pid in
+ Unix.close f;
+ if status <> Unix.WEXITED 0 then
+ out Unix.stdout "!!! reflector exited with an error\n";
+ out Unix.stdout "---- File tmpout.txt\n";
+ cat "./tmpout.txt";
+ Sys.remove "./tmpout.txt"
+
let test_open_process_in () =
let ic = Unix.open_process_in (refl ^ " -o 123 -o 456") in
out Unix.stdout (input_line ic ^ "\n");
test_2ampsup1();
out Unix.stdout "** create_process swap 1-2\n";
test_swap12();
+ out Unix.stdout "** create_process >file 2>&1\n";
+ test_12tofile();
out Unix.stdout "** open_process_in\n";
test_open_process_in();
out Unix.stdout "** open_process_out\n";
789
** create_process swap 1-2
123
+** create_process >file 2>&1
+---- File tmpout.txt
+123
+456
+789
** open_process_in
123
456
--- /dev/null
+(* TEST
+include unix
+flags += " -nolabels "
+* hasunix
+** bytecode
+** native
+*)
+
+module U : module type of Unix = UnixLabels
+
+let () =
+ ()
--- /dev/null
+(* TEST
+* hasunix
+include unix
+** bytecode
+** native
+*)
+
+let _ =
+ at_exit (fun () -> print_string "B\n"; flush stdout);
+ print_string "A\n"; (* don't flush *)
+ Unix._exit 0
--- /dev/null
+(* TEST
+include unix
+* libunix
+** bytecode
+** native
+*)
+
+let () =
+ let r = ref false in
+ Sys.set_signal Sys.sigint (Signal_handle (fun _ -> r := true));
+ Unix.kill (Unix.getpid ()) Sys.sigint;
+ let x = !r in
+ Printf.printf "%b " x;
+ Printf.printf "%b\n" !r
+
+let () =
+ let r = ref false in
+ let _ = Unix.sigprocmask SIG_BLOCK [Sys.sigint] in
+ Sys.set_signal Sys.sigint (Signal_handle (fun _ -> r := true));
+ Unix.kill (Unix.getpid ()) Sys.sigint;
+ Gc.full_major ();
+ let a = !r in
+ let _ = Unix.sigprocmask SIG_UNBLOCK [Sys.sigint] in
+ let b = !r in
+ Printf.printf "%b %b " a b;
+ Printf.printf "%b\n" !r
--- /dev/null
+true true
+false true true
--- /dev/null
+(* TEST
+
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+module = "empty.ml"
+*** ocamlc.byte
+module = ""
+flags = "-a"
+all_modules = ""
+program = "empty.cma"
+**** ocamlc.byte
+flags = ""
+program = "${test_build_directory}/empty.byte"
+all_modules = "empty.cma empty.cmo"
+***** check-ocamlc.byte-output
+* setup-ocamlopt.byte-build-env
+** ocamlopt.byte
+module = "empty.ml"
+*** ocamlopt.byte
+module = ""
+flags = "-a"
+all_modules = ""
+program = "empty.cmxa"
+**** ocamlopt.byte
+flags = ""
+program = "${test_build_directory}/empty.native"
+all_modules = "empty.cmxa empty.cmx"
+***** check-ocamlopt.byte-output
+*)
9 | | exception e -> ()
10 | | Some false -> ()
11 | | None -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
Some true
val test_match_exhaustiveness : unit -> unit = <fun>
2 | ....match None with
3 | | Some false -> ()
4 | | None | exception _ -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
Some true
val test_match_exhaustiveness_nest1 : unit -> unit = <fun>
2 | ....match None with
3 | | Some false | exception _ -> ()
4 | | None -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
Some true
val test_match_exhaustiveness_nest2 : unit -> unit = <fun>
3 | | exception e -> ()
4 | | Some false | exception _ -> ()
5 | | None | exception _ -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
Some true
Line 4, characters 29-30:
4 | | Some false | exception _ -> ()
^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
Line 5, characters 23-24:
5 | | None | exception _ -> ()
^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
val test_match_exhaustiveness_full : unit -> unit = <fun>
|}]
;;
Line 2, characters 0-9:
2 | open List
^^^^^^^^^
-Error (warning 33): unused open Stdlib.List.
+Error (warning 33 [unused-open]): unused open Stdlib.List.
|}];;
type unknown += Foo;;
--- /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 = create () in
+ set_key e x;
+ set_data e 42;
+ Gc.full_major ();
+ (x, get_data e)
+
+let () =
+ assert (ephe (ref 1000) = (ref 1000, Some 42));
+ match ephe (infix 12) with
+ | (h, Some 42) -> ()
+ | _ -> assert false
let gccount () = (Gc.quick_stat ()).Gc.major_collections;;
+type change = No_change | Fill | Erase;;
+
(* Check the correctness condition on the data at (i,j):
1. if the block is present, the weak pointer must be full
2. if the block was removed at GC n, and the weak pointer is still
*)
let check_and_change i j =
let gc1 = gccount () in
- match data.(i).objs.(j), Weak.check data.(i).wp j with
- | Present x, false -> assert false
- | Absent n, true -> assert (gc1 <= n+1)
- | Absent _, false ->
+ let change =
+ (* we only read data.(i).objs.(j) in this local binding to ensure
+ that it does not remain reachable on the bytecode stack
+ in the rest of the function below, when we overwrite the value
+ and try to observe its collection. *)
+ match data.(i).objs.(j), Weak.check data.(i).wp j with
+ | Present x, false -> assert false
+ | Absent n, true -> assert (gc1 <= n+1); No_change
+ | Absent _, false -> Fill
+ | Present _, true ->
+ if Random.int 10 = 0 then Erase else No_change
+ in
+ match change with
+ | No_change -> ()
+ | Fill ->
let x = Array.make (1 + Random.int 10) 42 in
data.(i).objs.(j) <- Present x;
Weak.set data.(i).wp j (Some x);
- | Present _, true ->
- if Random.int 10 = 0 then begin
- data.(i).objs.(j) <- Absent gc1;
- let gc2 = gccount () in
- if gc1 <> gc2 then data.(i).objs.(j) <- Absent gc2;
- end
+ | Erase ->
+ data.(i).objs.(j) <- Absent gc1;
+ let gc2 = gccount () in
+ if gc1 <> gc2 then data.(i).objs.(j) <- Absent gc2;
;;
let dummy = ref [||];;
File "aliases.ml", line 17, characters 12-13:
17 | module A' = A (* missing a.cmi *)
^
-Warning 49: no cmi file was found in path for module A
+Warning 49 [no-cmi-file]: no cmi file was found in path for module A
File "aliases.ml", line 18, characters 12-13:
18 | module B' = B (* broken b.cmi *)
^
-Warning 49: no valid cmi file was found in path for module B. b.cmi
+Warning 49 [no-cmi-file]: no valid cmi file was found in path for module B. b.cmi
is not a compiled interface
--- /dev/null
+Ptop_def
+ [
+ structure_item (//toplevel//[10,215+0]..[10,215+39])
+ Pstr_modtype "S" (//toplevel//[10,215+12]..[10,215+13])
+ module_type (//toplevel//[10,215+16]..[10,215+23])
+ attribute "attr"
+ [
+ structure_item (//toplevel//[10,215+31]..[10,215+38])
+ Pstr_eval
+ expression (//toplevel//[10,215+31]..[10,215+38])
+ Pexp_ident "payload" (//toplevel//[10,215+31]..[10,215+38])
+ ]
+ Pmty_signature
+ []
+ ]
+
+module type S = sig end
+Ptop_def
+ [
+ structure_item (//toplevel//[3,2+0]..[3,2+37])
+ Pstr_module
+ "M" (//toplevel//[3,2+7]..[3,2+8])
+ module_expr (//toplevel//[3,2+11]..[3,2+21])
+ attribute "attr"
+ [
+ structure_item (//toplevel//[3,2+29]..[3,2+36])
+ Pstr_eval
+ expression (//toplevel//[3,2+29]..[3,2+36])
+ Pexp_ident "payload" (//toplevel//[3,2+29]..[3,2+36])
+ ]
+ Pmod_structure
+ []
+ ]
+
+module M : sig end
+Ptop_def
+ [
+ structure_item (//toplevel//[2,1+0]..[2,1+28])
+ Pstr_type Rec
+ [
+ type_declaration "t" (//toplevel//[2,1+5]..[2,1+6]) (//toplevel//[2,1+0]..[2,1+28])
+ ptype_params =
+ []
+ ptype_cstrs =
+ []
+ ptype_kind =
+ Ptype_abstract
+ ptype_private = Public
+ ptype_manifest =
+ Some
+ core_type (//toplevel//[2,1+9]..[2,1+12])
+ attribute "attr"
+ [
+ structure_item (//toplevel//[2,1+20]..[2,1+27])
+ Pstr_eval
+ expression (//toplevel//[2,1+20]..[2,1+27])
+ Pexp_ident "payload" (//toplevel//[2,1+20]..[2,1+27])
+ ]
+ Ptyp_constr "int" (//toplevel//[2,1+9]..[2,1+12])
+ []
+ ]
+ ]
+
+type t = int
+Ptop_def
+ [
+ structure_item (//toplevel//[2,1+0]..[2,1+1])
+ Pstr_eval
+ expression (//toplevel//[2,1+0]..[2,1+1])
+ attribute "attr"
+ [
+ structure_item (//toplevel//[2,1+9]..[2,1+16])
+ Pstr_eval
+ expression (//toplevel//[2,1+9]..[2,1+16])
+ Pexp_ident "payload" (//toplevel//[2,1+9]..[2,1+16])
+ ]
+ Pexp_constant PConst_int (3,None)
+ ]
+
+- : int = 3
+Ptop_def
+ [
+ structure_item (//toplevel//[2,1+0]..[2,1+30])
+ Pstr_exception
+ type_exception
+ attribute "attr"
+ [
+ structure_item (//toplevel//[2,1+22]..[2,1+29])
+ Pstr_eval
+ expression (//toplevel//[2,1+22]..[2,1+29])
+ Pexp_ident "payload" (//toplevel//[2,1+22]..[2,1+29])
+ ]
+ ptyext_constructor =
+ extension_constructor (//toplevel//[2,1+0]..[2,1+13])
+ pext_name = "Exn"
+ pext_kind =
+ Pext_decl
+ []
+ None
+ ]
+
+exception Exn
+Ptop_def
+ [
+ structure_item (//toplevel//[4,17+0]..[4,17+50])
+ Pstr_modtype "F" (//toplevel//[4,17+12]..[4,17+13])
+ module_type (//toplevel//[4,17+24]..[4,17+50])
+ Pmty_functor "A" (//toplevel//[4,17+25]..[4,17+26])
+ module_type (//toplevel//[4,17+29]..[4,17+30])
+ Pmty_ident "S" (//toplevel//[4,17+29]..[4,17+30])
+ module_type (//toplevel//[4,17+32]..[4,17+50])
+ Pmty_functor "B" (//toplevel//[4,17+33]..[4,17+34])
+ module_type (//toplevel//[4,17+37]..[4,17+38])
+ Pmty_ident "S" (//toplevel//[4,17+37]..[4,17+38])
+ module_type (//toplevel//[4,17+43]..[4,17+50])
+ Pmty_signature
+ []
+ ]
+
+module type F = functor (A : S) (B : S) -> sig end
+Ptop_def
+ [
+ structure_item (//toplevel//[2,1+0]..[2,1+48])
+ Pstr_module
+ "F" (//toplevel//[2,1+7]..[2,1+8])
+ module_expr (//toplevel//[2,1+19]..[2,1+48])
+ Pmod_functor "A" (//toplevel//[2,1+20]..[2,1+21])
+ module_type (//toplevel//[2,1+24]..[2,1+25])
+ Pmty_ident "S" (//toplevel//[2,1+24]..[2,1+25])
+ module_expr (//toplevel//[2,1+27]..[2,1+48])
+ Pmod_functor "B" (//toplevel//[2,1+28]..[2,1+29])
+ module_type (//toplevel//[2,1+32]..[2,1+33])
+ Pmty_ident "S" (//toplevel//[2,1+32]..[2,1+33])
+ module_expr (//toplevel//[2,1+38]..[2,1+48])
+ Pmod_structure
+ []
+ ]
+
+module F : functor (A : S) (B : S) -> sig end
+Ptop_def
+ [
+ structure_item (//toplevel//[4,18+0]..[4,18+31])
+ Pstr_modtype "S1" (//toplevel//[4,18+12]..[4,18+14])
+ module_type (//toplevel//[4,18+17]..[4,18+31])
+ Pmty_signature
+ [
+ signature_item (//toplevel//[4,18+21]..[4,18+27])
+ Psig_type Rec
+ [
+ type_declaration "t" (//toplevel//[4,18+26]..[4,18+27]) (//toplevel//[4,18+21]..[4,18+27])
+ ptype_params =
+ []
+ ptype_cstrs =
+ []
+ ptype_kind =
+ Ptype_abstract
+ ptype_private = Public
+ ptype_manifest =
+ None
+ ]
+ ]
+ ]
+
+module type S1 = sig type t end
+Ptop_def
+ [
+ structure_item (//toplevel//[2,1+0]..[2,1+37])
+ Pstr_modtype "T1" (//toplevel//[2,1+12]..[2,1+14])
+ module_type (//toplevel//[2,1+17]..[2,1+37])
+ Pmty_with
+ module_type (//toplevel//[2,1+17]..[2,1+19])
+ Pmty_ident "S1" (//toplevel//[2,1+17]..[2,1+19])
+ [
+ Pwith_type "t" (//toplevel//[2,1+30]..[2,1+31])
+ type_declaration "t" (//toplevel//[2,1+30]..[2,1+31]) (//toplevel//[2,1+25]..[2,1+37])
+ ptype_params =
+ []
+ ptype_cstrs =
+ []
+ ptype_kind =
+ Ptype_abstract
+ ptype_private = Public
+ ptype_manifest =
+ Some
+ core_type (//toplevel//[2,1+34]..[2,1+37])
+ Ptyp_constr "int" (//toplevel//[2,1+34]..[2,1+37])
+ []
+ ]
+ ]
+
+module type T1 = sig type t = int end
+Ptop_def
+ [
+ structure_item (//toplevel//[2,1+0]..[2,1+38])
+ Pstr_modtype "T1" (//toplevel//[2,1+12]..[2,1+14])
+ module_type (//toplevel//[2,1+17]..[2,1+38])
+ Pmty_with
+ module_type (//toplevel//[2,1+17]..[2,1+19])
+ Pmty_ident "S1" (//toplevel//[2,1+17]..[2,1+19])
+ [
+ Pwith_typesubst "t" (//toplevel//[2,1+30]..[2,1+31])
+ type_declaration "t" (//toplevel//[2,1+30]..[2,1+31]) (//toplevel//[2,1+25]..[2,1+38])
+ ptype_params =
+ []
+ ptype_cstrs =
+ []
+ ptype_kind =
+ Ptype_abstract
+ ptype_private = Public
+ ptype_manifest =
+ Some
+ core_type (//toplevel//[2,1+35]..[2,1+38])
+ Ptyp_constr "int" (//toplevel//[2,1+35]..[2,1+38])
+ []
+ ]
+ ]
+
+module type T1 = sig end
+Ptop_def
+ [
+ structure_item (//toplevel//[4,29+0]..[4,29+15])
+ Pstr_value Nonrec
+ [
+ <def>
+ pattern (//toplevel//[4,29+4]..[4,29+11]) ghost
+ Ppat_constraint
+ pattern (//toplevel//[4,29+4]..[4,29+5])
+ Ppat_var "x" (//toplevel//[4,29+4]..[4,29+5])
+ core_type (//toplevel//[4,29+8]..[4,29+11]) ghost
+ Ptyp_poly
+ 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
+ Pexp_constraint
+ expression (//toplevel//[4,29+14]..[4,29+15])
+ Pexp_constant PConst_int (3,None)
+ core_type (//toplevel//[4,29+8]..[4,29+11])
+ Ptyp_constr "int" (//toplevel//[4,29+8]..[4,29+11])
+ []
+ ]
+ ]
+
+val x : int = 3
+Ptop_def
+ [
+ structure_item (//toplevel//[2,1+0]..[2,1+35])
+ Pstr_value Nonrec
+ [
+ <def>
+ pattern (//toplevel//[2,1+4]..[2,1+22]) ghost
+ Ppat_constraint
+ pattern (//toplevel//[2,1+4]..[2,1+5])
+ Ppat_var "x" (//toplevel//[2,1+4]..[2,1+5])
+ core_type (//toplevel//[2,1+4]..[2,1+35]) ghost
+ Ptyp_poly 'a
+ core_type (//toplevel//[2,1+16]..[2,1+22])
+ Ptyp_arrow
+ Nolabel
+ core_type (//toplevel//[2,1+16]..[2,1+17])
+ Ptyp_var a
+ core_type (//toplevel//[2,1+21]..[2,1+22])
+ Ptyp_var a
+ expression (//toplevel//[2,1+4]..[2,1+35])
+ Pexp_newtype "a"
+ expression (//toplevel//[2,1+4]..[2,1+35])
+ Pexp_constraint
+ expression (//toplevel//[2,1+25]..[2,1+35])
+ Pexp_fun
+ Nolabel
+ None
+ pattern (//toplevel//[2,1+29]..[2,1+30])
+ Ppat_var "x" (//toplevel//[2,1+29]..[2,1+30])
+ expression (//toplevel//[2,1+34]..[2,1+35])
+ Pexp_ident "x" (//toplevel//[2,1+34]..[2,1+35])
+ core_type (//toplevel//[2,1+16]..[2,1+22])
+ Ptyp_arrow
+ Nolabel
+ core_type (//toplevel//[2,1+16]..[2,1+17])
+ Ptyp_constr "a" (//toplevel//[2,1+16]..[2,1+17])
+ []
+ core_type (//toplevel//[2,1+21]..[2,1+22])
+ Ptyp_constr "a" (//toplevel//[2,1+21]..[2,1+22])
+ []
+ ]
+ ]
+
+val x : 'a -> 'a = <fun>
+Ptop_def
+ [
+ structure_item (//toplevel//[2,1+0]..[5,61+3])
+ Pstr_value Nonrec
+ [
+ <def>
+ pattern (//toplevel//[2,1+4]..[2,1+5])
+ Ppat_any
+ expression (//toplevel//[2,1+8]..[5,61+3])
+ Pexp_object
+ class_structure
+ pattern (//toplevel//[2,1+14]..[2,1+14]) ghost
+ Ppat_any
+ [
+ class_field (//toplevel//[3,16+2]..[4,46+14])
+ Pcf_method Public
+ "x" (//toplevel//[3,16+9]..[3,16+10])
+ Concrete Fresh
+ expression (//toplevel//[3,16+18]..[4,46+14]) ghost
+ Pexp_poly
+ expression (//toplevel//[3,16+9]..[4,46+14])
+ Pexp_newtype "a"
+ expression (//toplevel//[3,16+9]..[4,46+14])
+ Pexp_constraint
+ expression (//toplevel//[4,46+4]..[4,46+14])
+ Pexp_fun
+ Nolabel
+ None
+ pattern (//toplevel//[4,46+8]..[4,46+9])
+ Ppat_var "x" (//toplevel//[4,46+8]..[4,46+9])
+ expression (//toplevel//[4,46+13]..[4,46+14])
+ Pexp_ident "x" (//toplevel//[4,46+13]..[4,46+14])
+ core_type (//toplevel//[3,16+21]..[3,16+27])
+ Ptyp_arrow
+ Nolabel
+ core_type (//toplevel//[3,16+21]..[3,16+22])
+ Ptyp_constr "a" (//toplevel//[3,16+21]..[3,16+22])
+ []
+ core_type (//toplevel//[3,16+26]..[3,16+27])
+ Ptyp_constr "a" (//toplevel//[3,16+26]..[3,16+27])
+ []
+ Some
+ core_type (//toplevel//[3,16+9]..[4,46+14]) ghost
+ Ptyp_poly 'a
+ core_type (//toplevel//[3,16+21]..[3,16+27])
+ Ptyp_arrow
+ Nolabel
+ core_type (//toplevel//[3,16+21]..[3,16+22])
+ Ptyp_var a
+ core_type (//toplevel//[3,16+26]..[3,16+27])
+ Ptyp_var a
+ ]
+ ]
+ ]
+
+- : < x : 'a. 'a -> 'a > = <obj>
+Ptop_def
+ [
+ structure_item (//toplevel//[4,17+0]..[4,17+29])
+ Pstr_value Nonrec
+ [
+ <def>
+ pattern (//toplevel//[4,17+4]..[4,17+5])
+ Ppat_var "x" (//toplevel//[4,17+4]..[4,17+5])
+ expression (//toplevel//[4,17+6]..[4,17+29]) ghost
+ Pexp_fun
+ Nolabel
+ None
+ pattern (//toplevel//[4,17+6]..[4,17+14])
+ Ppat_var "contents" (//toplevel//[4,17+6]..[4,17+14])
+ 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
+ ]
+ None
+ ]
+ ]
+
+val x : 'a -> 'a ref = <fun>
+Ptop_def
+ [
+ structure_item (//toplevel//[2,1+0]..[2,1+30])
+ Pstr_value Nonrec
+ [
+ <def>
+ pattern (//toplevel//[2,1+4]..[2,1+5])
+ Ppat_var "x" (//toplevel//[2,1+4]..[2,1+5])
+ expression (//toplevel//[2,1+8]..[2,1+30])
+ Pexp_record
+ [
+ "contents" (//toplevel//[2,1+10]..[2,1+18])
+ expression (//toplevel//[2,1+10]..[2,1+28]) ghost
+ Pexp_constraint
+ expression (//toplevel//[2,1+27]..[2,1+28])
+ Pexp_constant PConst_int (3,None)
+ core_type (//toplevel//[2,1+21]..[2,1+24])
+ Ptyp_constr "int" (//toplevel//[2,1+21]..[2,1+24])
+ []
+ ]
+ None
+ ]
+ ]
+
+val x : int ref = {contents = 3}
+Ptop_def
+ [
+ structure_item (//toplevel//[2,1+0]..[2,1+35])
+ Pstr_value Nonrec
+ [
+ <def>
+ pattern (//toplevel//[2,1+4]..[2,1+5])
+ Ppat_var "x" (//toplevel//[2,1+4]..[2,1+5])
+ expression (//toplevel//[2,1+6]..[2,1+35]) ghost
+ Pexp_fun
+ Nolabel
+ None
+ pattern (//toplevel//[2,1+6]..[2,1+14])
+ Ppat_var "contents" (//toplevel//[2,1+6]..[2,1+14])
+ 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
+ Pexp_constraint
+ expression (//toplevel//[2,1+19]..[2,1+33]) ghost
+ Pexp_ident "contents" (//toplevel//[2,1+19]..[2,1+27]) ghost
+ core_type (//toplevel//[2,1+30]..[2,1+33])
+ Ptyp_constr "int" (//toplevel//[2,1+30]..[2,1+33])
+ []
+ ]
+ None
+ ]
+ ]
+
+val x : int -> int ref = <fun>
+Ptop_def
+ [
+ structure_item (//toplevel//[2,1+0]..[2,1+41])
+ Pstr_value Nonrec
+ [
+ <def>
+ pattern (//toplevel//[2,1+4]..[2,1+5])
+ Ppat_var "x" (//toplevel//[2,1+4]..[2,1+5])
+ expression (//toplevel//[2,1+8]..[2,1+41])
+ Pexp_function
+ [
+ <case>
+ pattern (//toplevel//[2,1+17]..[2,1+29])
+ Ppat_record Closed
+ [
+ "contents" (//toplevel//[2,1+19]..[2,1+27]) ghost
+ pattern (//toplevel//[2,1+19]..[2,1+27])
+ Ppat_var "contents" (//toplevel//[2,1+19]..[2,1+27])
+ ]
+ expression (//toplevel//[2,1+33]..[2,1+41])
+ Pexp_ident "contents" (//toplevel//[2,1+33]..[2,1+41])
+ ]
+ ]
+ ]
+
+val x : 'a ref -> 'a = <fun>
+Ptop_def
+ [
+ structure_item (//toplevel//[2,1+0]..[2,1+47])
+ Pstr_value Nonrec
+ [
+ <def>
+ pattern (//toplevel//[2,1+4]..[2,1+5])
+ Ppat_var "x" (//toplevel//[2,1+4]..[2,1+5])
+ expression (//toplevel//[2,1+8]..[2,1+47])
+ Pexp_function
+ [
+ <case>
+ pattern (//toplevel//[2,1+17]..[2,1+35])
+ Ppat_record Closed
+ [
+ "contents" (//toplevel//[2,1+19]..[2,1+27]) ghost
+ pattern (//toplevel//[2,1+19]..[2,1+33]) ghost
+ Ppat_constraint
+ pattern (//toplevel//[2,1+19]..[2,1+27])
+ Ppat_var "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])
+ []
+ ]
+ expression (//toplevel//[2,1+39]..[2,1+47])
+ Pexp_ident "contents" (//toplevel//[2,1+39]..[2,1+47])
+ ]
+ ]
+ ]
+
+val x : int ref -> int = <fun>
+Ptop_def
+ [
+ structure_item (//toplevel//[2,1+0]..[2,1+44])
+ Pstr_value Nonrec
+ [
+ <def>
+ pattern (//toplevel//[2,1+4]..[2,1+5])
+ Ppat_var "x" (//toplevel//[2,1+4]..[2,1+5])
+ expression (//toplevel//[2,1+8]..[2,1+44])
+ Pexp_function
+ [
+ <case>
+ pattern (//toplevel//[2,1+17]..[2,1+39])
+ Ppat_record Closed
+ [
+ "contents" (//toplevel//[2,1+19]..[2,1+27])
+ pattern (//toplevel//[2,1+19]..[2,1+37]) ghost
+ Ppat_constraint
+ pattern (//toplevel//[2,1+36]..[2,1+37])
+ Ppat_var "i" (//toplevel//[2,1+36]..[2,1+37])
+ core_type (//toplevel//[2,1+30]..[2,1+33])
+ Ptyp_constr "int" (//toplevel//[2,1+30]..[2,1+33])
+ []
+ ]
+ expression (//toplevel//[2,1+43]..[2,1+44])
+ Pexp_ident "i" (//toplevel//[2,1+43]..[2,1+44])
+ ]
+ ]
+ ]
+
+val x : int ref -> int = <fun>
+Ptop_def
+ [
+ structure_item (//toplevel//[4,19+0]..[4,19+26])
+ Pstr_value Nonrec
+ [
+ <def>
+ pattern (//toplevel//[4,19+4]..[4,19+5])
+ Ppat_var "x" (//toplevel//[4,19+4]..[4,19+5])
+ expression (//toplevel//[4,19+8]..[4,19+26])
+ Pexp_open Fresh
+ module_expr (//toplevel//[4,19+8]..[4,19+9])
+ Pmod_ident "M" (//toplevel//[4,19+8]..[4,19+9])
+ expression (//toplevel//[4,19+10]..[4,19+26])
+ Pexp_record
+ [
+ "contents" (//toplevel//[4,19+12]..[4,19+20])
+ expression (//toplevel//[4,19+23]..[4,19+24])
+ Pexp_constant PConst_int (3,None)
+ ]
+ None
+ ]
+ ]
+
+val x : int ref = {contents = 3}
+Ptop_def
+ [
+ structure_item (//toplevel//[2,1+0]..[2,1+18])
+ Pstr_value Nonrec
+ [
+ <def>
+ pattern (//toplevel//[2,1+4]..[2,1+5])
+ Ppat_var "x" (//toplevel//[2,1+4]..[2,1+5])
+ expression (//toplevel//[2,1+8]..[2,1+18])
+ Pexp_open Fresh
+ module_expr (//toplevel//[2,1+8]..[2,1+9])
+ Pmod_ident "M" (//toplevel//[2,1+8]..[2,1+9])
+ expression (//toplevel//[2,1+10]..[2,1+18])
+ Pexp_construct "::" (//toplevel//[2,1+12]..[2,1+18]) ghost
+ Some
+ expression (//toplevel//[2,1+12]..[2,1+18]) ghost
+ Pexp_tuple
+ [
+ expression (//toplevel//[2,1+12]..[2,1+13])
+ Pexp_constant PConst_int (3,None)
+ expression (//toplevel//[2,1+15]..[2,1+18]) ghost
+ Pexp_construct "::" (//toplevel//[2,1+15]..[2,1+18]) ghost
+ Some
+ expression (//toplevel//[2,1+15]..[2,1+18]) ghost
+ Pexp_tuple
+ [
+ expression (//toplevel//[2,1+15]..[2,1+16])
+ Pexp_constant PConst_int (4,None)
+ expression (//toplevel//[2,1+17]..[2,1+18]) ghost
+ Pexp_construct "[]" (//toplevel//[2,1+17]..[2,1+18]) ghost
+ None
+ ]
+ ]
+ ]
+ ]
+
+val x : int list = [3; 4]
+Ptop_def
+ [
+ structure_item (//toplevel//[2,1+0]..[2,1+18])
+ Pstr_value Nonrec
+ [
+ <def>
+ pattern (//toplevel//[2,1+4]..[2,1+5])
+ Ppat_var "x" (//toplevel//[2,1+4]..[2,1+5])
+ expression (//toplevel//[2,1+8]..[2,1+18])
+ Pexp_open Fresh
+ module_expr (//toplevel//[2,1+8]..[2,1+9])
+ Pmod_ident "M" (//toplevel//[2,1+8]..[2,1+9])
+ expression (//toplevel//[2,1+12]..[2,1+16])
+ Pexp_sequence
+ expression (//toplevel//[2,1+12]..[2,1+13])
+ Pexp_constant PConst_int (3,None)
+ expression (//toplevel//[2,1+15]..[2,1+16])
+ Pexp_constant PConst_int (4,None)
+ ]
+ ]
+
+Line 2, characters 12-13:
+2 | let x = M.( 3; 4 );;
+ ^
+Warning 10 [non-unit-statement]: this expression should have type unit.
+val x : int = 4
+Ptop_def
+ [
+ structure_item (//toplevel//[6,56+0]..[6,56+24])
+ Pstr_value Nonrec
+ [
+ <def>
+ pattern (//toplevel//[6,56+4]..[6,56+12])
+ Ppat_var ".@()" (//toplevel//[6,56+4]..[6,56+12])
+ expression (//toplevel//[6,56+13]..[6,56+24]) ghost
+ Pexp_fun
+ Nolabel
+ None
+ pattern (//toplevel//[6,56+13]..[6,56+14])
+ Ppat_var "x" (//toplevel//[6,56+13]..[6,56+14])
+ expression (//toplevel//[6,56+15]..[6,56+24]) ghost
+ Pexp_fun
+ Nolabel
+ None
+ pattern (//toplevel//[6,56+15]..[6,56+16])
+ Ppat_var "y" (//toplevel//[6,56+15]..[6,56+16])
+ expression (//toplevel//[6,56+19]..[6,56+24])
+ Pexp_apply
+ expression (//toplevel//[6,56+21]..[6,56+22])
+ Pexp_ident "+" (//toplevel//[6,56+21]..[6,56+22])
+ [
+ <arg>
+ Nolabel
+ expression (//toplevel//[6,56+19]..[6,56+20])
+ Pexp_ident "x" (//toplevel//[6,56+19]..[6,56+20])
+ <arg>
+ Nolabel
+ expression (//toplevel//[6,56+23]..[6,56+24])
+ Pexp_ident "y" (//toplevel//[6,56+23]..[6,56+24])
+ ]
+ ]
+ structure_item (//toplevel//[7,81+0]..[7,81+32])
+ Pstr_value Nonrec
+ [
+ <def>
+ pattern (//toplevel//[7,81+4]..[7,81+14])
+ Ppat_var ".@()<-" (//toplevel//[7,81+4]..[7,81+14])
+ expression (//toplevel//[7,81+15]..[7,81+32]) ghost
+ Pexp_fun
+ Nolabel
+ None
+ pattern (//toplevel//[7,81+15]..[7,81+16])
+ Ppat_var "x" (//toplevel//[7,81+15]..[7,81+16])
+ expression (//toplevel//[7,81+17]..[7,81+32]) ghost
+ Pexp_fun
+ Nolabel
+ None
+ pattern (//toplevel//[7,81+17]..[7,81+18])
+ Ppat_var "y" (//toplevel//[7,81+17]..[7,81+18])
+ expression (//toplevel//[7,81+19]..[7,81+32]) ghost
+ Pexp_fun
+ Nolabel
+ None
+ pattern (//toplevel//[7,81+19]..[7,81+20])
+ Ppat_var "z" (//toplevel//[7,81+19]..[7,81+20])
+ expression (//toplevel//[7,81+23]..[7,81+32])
+ Pexp_apply
+ expression (//toplevel//[7,81+29]..[7,81+30])
+ Pexp_ident "+" (//toplevel//[7,81+29]..[7,81+30])
+ [
+ <arg>
+ Nolabel
+ expression (//toplevel//[7,81+23]..[7,81+28])
+ Pexp_apply
+ expression (//toplevel//[7,81+25]..[7,81+26])
+ Pexp_ident "+" (//toplevel//[7,81+25]..[7,81+26])
+ [
+ <arg>
+ Nolabel
+ expression (//toplevel//[7,81+23]..[7,81+24])
+ Pexp_ident "x" (//toplevel//[7,81+23]..[7,81+24])
+ <arg>
+ Nolabel
+ expression (//toplevel//[7,81+27]..[7,81+28])
+ Pexp_ident "y" (//toplevel//[7,81+27]..[7,81+28])
+ ]
+ <arg>
+ Nolabel
+ expression (//toplevel//[7,81+31]..[7,81+32])
+ Pexp_ident "z" (//toplevel//[7,81+31]..[7,81+32])
+ ]
+ ]
+ structure_item (//toplevel//[8,114+0]..[8,114+25])
+ Pstr_value Nonrec
+ [
+ <def>
+ pattern (//toplevel//[8,114+4]..[8,114+13])
+ Ppat_var ".%.{}" (//toplevel//[8,114+4]..[8,114+13])
+ expression (//toplevel//[8,114+14]..[8,114+25]) ghost
+ Pexp_fun
+ Nolabel
+ None
+ pattern (//toplevel//[8,114+14]..[8,114+15])
+ Ppat_var "x" (//toplevel//[8,114+14]..[8,114+15])
+ expression (//toplevel//[8,114+16]..[8,114+25]) ghost
+ Pexp_fun
+ Nolabel
+ None
+ pattern (//toplevel//[8,114+16]..[8,114+17])
+ Ppat_var "y" (//toplevel//[8,114+16]..[8,114+17])
+ expression (//toplevel//[8,114+20]..[8,114+25])
+ Pexp_apply
+ expression (//toplevel//[8,114+22]..[8,114+23])
+ Pexp_ident "+" (//toplevel//[8,114+22]..[8,114+23])
+ [
+ <arg>
+ Nolabel
+ expression (//toplevel//[8,114+20]..[8,114+21])
+ Pexp_ident "x" (//toplevel//[8,114+20]..[8,114+21])
+ <arg>
+ Nolabel
+ expression (//toplevel//[8,114+24]..[8,114+25])
+ Pexp_ident "y" (//toplevel//[8,114+24]..[8,114+25])
+ ]
+ ]
+ structure_item (//toplevel//[9,140+0]..[9,140+33])
+ Pstr_value Nonrec
+ [
+ <def>
+ pattern (//toplevel//[9,140+4]..[9,140+15])
+ Ppat_var ".%.{}<-" (//toplevel//[9,140+4]..[9,140+15])
+ expression (//toplevel//[9,140+16]..[9,140+33]) ghost
+ Pexp_fun
+ Nolabel
+ None
+ pattern (//toplevel//[9,140+16]..[9,140+17])
+ Ppat_var "x" (//toplevel//[9,140+16]..[9,140+17])
+ expression (//toplevel//[9,140+18]..[9,140+33]) ghost
+ Pexp_fun
+ Nolabel
+ None
+ pattern (//toplevel//[9,140+18]..[9,140+19])
+ Ppat_var "y" (//toplevel//[9,140+18]..[9,140+19])
+ expression (//toplevel//[9,140+20]..[9,140+33]) ghost
+ Pexp_fun
+ Nolabel
+ None
+ pattern (//toplevel//[9,140+20]..[9,140+21])
+ Ppat_var "z" (//toplevel//[9,140+20]..[9,140+21])
+ expression (//toplevel//[9,140+24]..[9,140+33])
+ Pexp_apply
+ expression (//toplevel//[9,140+30]..[9,140+31])
+ Pexp_ident "+" (//toplevel//[9,140+30]..[9,140+31])
+ [
+ <arg>
+ Nolabel
+ expression (//toplevel//[9,140+24]..[9,140+29])
+ Pexp_apply
+ expression (//toplevel//[9,140+26]..[9,140+27])
+ Pexp_ident "+" (//toplevel//[9,140+26]..[9,140+27])
+ [
+ <arg>
+ Nolabel
+ expression (//toplevel//[9,140+24]..[9,140+25])
+ Pexp_ident "x" (//toplevel//[9,140+24]..[9,140+25])
+ <arg>
+ Nolabel
+ expression (//toplevel//[9,140+28]..[9,140+29])
+ Pexp_ident "y" (//toplevel//[9,140+28]..[9,140+29])
+ ]
+ <arg>
+ Nolabel
+ expression (//toplevel//[9,140+32]..[9,140+33])
+ Pexp_ident "z" (//toplevel//[9,140+32]..[9,140+33])
+ ]
+ ]
+ structure_item (//toplevel//[10,174+0]..[10,174+25])
+ Pstr_value Nonrec
+ [
+ <def>
+ pattern (//toplevel//[10,174+4]..[10,174+13])
+ Ppat_var ".%.[]" (//toplevel//[10,174+4]..[10,174+13])
+ expression (//toplevel//[10,174+14]..[10,174+25]) ghost
+ Pexp_fun
+ Nolabel
+ None
+ pattern (//toplevel//[10,174+14]..[10,174+15])
+ Ppat_var "x" (//toplevel//[10,174+14]..[10,174+15])
+ expression (//toplevel//[10,174+16]..[10,174+25]) ghost
+ Pexp_fun
+ Nolabel
+ None
+ pattern (//toplevel//[10,174+16]..[10,174+17])
+ Ppat_var "y" (//toplevel//[10,174+16]..[10,174+17])
+ expression (//toplevel//[10,174+20]..[10,174+25])
+ Pexp_apply
+ expression (//toplevel//[10,174+22]..[10,174+23])
+ Pexp_ident "+" (//toplevel//[10,174+22]..[10,174+23])
+ [
+ <arg>
+ Nolabel
+ expression (//toplevel//[10,174+20]..[10,174+21])
+ Pexp_ident "x" (//toplevel//[10,174+20]..[10,174+21])
+ <arg>
+ Nolabel
+ expression (//toplevel//[10,174+24]..[10,174+25])
+ Pexp_ident "y" (//toplevel//[10,174+24]..[10,174+25])
+ ]
+ ]
+ structure_item (//toplevel//[11,200+0]..[11,200+33])
+ Pstr_value Nonrec
+ [
+ <def>
+ pattern (//toplevel//[11,200+4]..[11,200+15])
+ Ppat_var ".%.[]<-" (//toplevel//[11,200+4]..[11,200+15])
+ expression (//toplevel//[11,200+16]..[11,200+33]) ghost
+ Pexp_fun
+ Nolabel
+ None
+ pattern (//toplevel//[11,200+16]..[11,200+17])
+ Ppat_var "x" (//toplevel//[11,200+16]..[11,200+17])
+ expression (//toplevel//[11,200+18]..[11,200+33]) ghost
+ Pexp_fun
+ Nolabel
+ None
+ pattern (//toplevel//[11,200+18]..[11,200+19])
+ Ppat_var "y" (//toplevel//[11,200+18]..[11,200+19])
+ expression (//toplevel//[11,200+20]..[11,200+33]) ghost
+ Pexp_fun
+ Nolabel
+ None
+ pattern (//toplevel//[11,200+20]..[11,200+21])
+ Ppat_var "z" (//toplevel//[11,200+20]..[11,200+21])
+ expression (//toplevel//[11,200+24]..[11,200+33])
+ Pexp_apply
+ expression (//toplevel//[11,200+30]..[11,200+31])
+ Pexp_ident "+" (//toplevel//[11,200+30]..[11,200+31])
+ [
+ <arg>
+ Nolabel
+ expression (//toplevel//[11,200+24]..[11,200+29])
+ Pexp_apply
+ expression (//toplevel//[11,200+26]..[11,200+27])
+ Pexp_ident "+" (//toplevel//[11,200+26]..[11,200+27])
+ [
+ <arg>
+ Nolabel
+ expression (//toplevel//[11,200+24]..[11,200+25])
+ Pexp_ident "x" (//toplevel//[11,200+24]..[11,200+25])
+ <arg>
+ Nolabel
+ expression (//toplevel//[11,200+28]..[11,200+29])
+ Pexp_ident "y" (//toplevel//[11,200+28]..[11,200+29])
+ ]
+ <arg>
+ Nolabel
+ expression (//toplevel//[11,200+32]..[11,200+33])
+ Pexp_ident "z" (//toplevel//[11,200+32]..[11,200+33])
+ ]
+ ]
+ ]
+
+val ( .@() ) : int -> int -> int = <fun>
+val ( .@()<- ) : int -> int -> int -> int = <fun>
+val ( .%.{} ) : int -> int -> int = <fun>
+val ( .%.{}<- ) : int -> int -> int -> int = <fun>
+val ( .%.[] ) : int -> int -> int = <fun>
+val ( .%.[]<- ) : int -> int -> int -> int = <fun>
+Ptop_def
+ [
+ structure_item (//toplevel//[4,27+0]..[4,27+6])
+ Pstr_eval
+ expression (//toplevel//[4,27+0]..[4,27+6])
+ Pexp_apply
+ expression (//toplevel//[4,27+0]..[4,27+6]) ghost
+ Pexp_ident ".@()" (//toplevel//[4,27+0]..[4,27+6]) ghost
+ [
+ <arg>
+ Nolabel
+ expression (//toplevel//[4,27+0]..[4,27+1])
+ Pexp_ident "x" (//toplevel//[4,27+0]..[4,27+1])
+ <arg>
+ Nolabel
+ expression (//toplevel//[4,27+4]..[4,27+5])
+ Pexp_constant PConst_int (4,None)
+ ]
+ ]
+
+- : int = 8
+Ptop_def
+ [
+ structure_item (//toplevel//[1,0+0]..[1,0+11])
+ Pstr_eval
+ expression (//toplevel//[1,0+0]..[1,0+11])
+ Pexp_apply
+ expression (//toplevel//[1,0+0]..[1,0+11]) ghost
+ Pexp_ident ".@()<-" (//toplevel//[1,0+0]..[1,0+11]) ghost
+ [
+ <arg>
+ Nolabel
+ expression (//toplevel//[1,0+0]..[1,0+1])
+ Pexp_ident "x" (//toplevel//[1,0+0]..[1,0+1])
+ <arg>
+ Nolabel
+ expression (//toplevel//[1,0+4]..[1,0+5])
+ Pexp_constant PConst_int (4,None)
+ <arg>
+ Nolabel
+ expression (//toplevel//[1,0+10]..[1,0+11])
+ Pexp_constant PConst_int (4,None)
+ ]
+ ]
+
+- : int = 12
+Ptop_def
+ [
+ structure_item (//toplevel//[2,1+0]..[2,1+7])
+ Pstr_eval
+ expression (//toplevel//[2,1+0]..[2,1+7])
+ Pexp_apply
+ expression (//toplevel//[2,1+0]..[2,1+7]) ghost
+ Pexp_ident ".%.{}" (//toplevel//[2,1+0]..[2,1+7]) ghost
+ [
+ <arg>
+ Nolabel
+ expression (//toplevel//[2,1+0]..[2,1+1])
+ Pexp_ident "x" (//toplevel//[2,1+0]..[2,1+1])
+ <arg>
+ Nolabel
+ expression (//toplevel//[2,1+5]..[2,1+6])
+ Pexp_constant PConst_int (4,None)
+ ]
+ ]
+
+- : int = 8
+Ptop_def
+ [
+ structure_item (//toplevel//[1,0+0]..[1,0+12])
+ Pstr_eval
+ expression (//toplevel//[1,0+0]..[1,0+12])
+ Pexp_apply
+ expression (//toplevel//[1,0+0]..[1,0+12]) ghost
+ Pexp_ident ".%.{}<-" (//toplevel//[1,0+0]..[1,0+12]) ghost
+ [
+ <arg>
+ Nolabel
+ expression (//toplevel//[1,0+0]..[1,0+1])
+ Pexp_ident "x" (//toplevel//[1,0+0]..[1,0+1])
+ <arg>
+ Nolabel
+ expression (//toplevel//[1,0+5]..[1,0+6])
+ Pexp_constant PConst_int (4,None)
+ <arg>
+ Nolabel
+ expression (//toplevel//[1,0+11]..[1,0+12])
+ Pexp_constant PConst_int (4,None)
+ ]
+ ]
+
+- : int = 12
+Ptop_def
+ [
+ structure_item (//toplevel//[2,1+0]..[2,1+7])
+ Pstr_eval
+ expression (//toplevel//[2,1+0]..[2,1+7])
+ Pexp_apply
+ expression (//toplevel//[2,1+0]..[2,1+7]) ghost
+ Pexp_ident ".%.[]" (//toplevel//[2,1+0]..[2,1+7]) ghost
+ [
+ <arg>
+ Nolabel
+ expression (//toplevel//[2,1+0]..[2,1+1])
+ Pexp_ident "x" (//toplevel//[2,1+0]..[2,1+1])
+ <arg>
+ Nolabel
+ expression (//toplevel//[2,1+5]..[2,1+6])
+ Pexp_constant PConst_int (4,None)
+ ]
+ ]
+
+- : int = 8
+Ptop_def
+ [
+ structure_item (//toplevel//[1,0+0]..[1,0+12])
+ Pstr_eval
+ expression (//toplevel//[1,0+0]..[1,0+12])
+ Pexp_apply
+ expression (//toplevel//[1,0+0]..[1,0+12]) ghost
+ Pexp_ident ".%.[]<-" (//toplevel//[1,0+0]..[1,0+12]) ghost
+ [
+ <arg>
+ Nolabel
+ expression (//toplevel//[1,0+0]..[1,0+1])
+ Pexp_ident "x" (//toplevel//[1,0+0]..[1,0+1])
+ <arg>
+ Nolabel
+ expression (//toplevel//[1,0+5]..[1,0+6])
+ Pexp_constant PConst_int (4,None)
+ <arg>
+ Nolabel
+ expression (//toplevel//[1,0+11]..[1,0+12])
+ Pexp_constant PConst_int (4,None)
+ ]
+ ]
+
+- : int = 12
+Ptop_def
+ [
+ structure_item (//toplevel//[4,28+0]..[4,28+37])
+ Pstr_value Nonrec
+ [
+ <def>
+ pattern (//toplevel//[4,28+4]..[4,28+5])
+ Ppat_var "f" (//toplevel//[4,28+4]..[4,28+5])
+ expression (//toplevel//[4,28+8]..[4,28+37])
+ Pexp_function
+ [
+ <case>
+ pattern (//toplevel//[4,28+17]..[4,28+31])
+ Ppat_constraint
+ pattern (//toplevel//[4,28+25]..[4,28+26])
+ Ppat_unpack "M" (//toplevel//[4,28+25]..[4,28+26])
+ core_type (//toplevel//[4,28+29]..[4,28+30])
+ Ptyp_package "S" (//toplevel//[4,28+29]..[4,28+30])
+ []
+ expression (//toplevel//[4,28+35]..[4,28+37])
+ Pexp_construct "()" (//toplevel//[4,28+35]..[4,28+37])
+ None
+ ]
+ ]
+ ]
+
+val f : (module S) -> unit = <fun>
+Ptop_def
+ [
+ structure_item (//toplevel//[4,45+0]..[6,71+12])
+ Pstr_class
+ [
+ class_declaration (//toplevel//[4,45+0]..[6,71+12])
+ pci_virt = Concrete
+ pci_params =
+ []
+ pci_name = "c" (//toplevel//[4,45+6]..[4,45+7])
+ pci_expr =
+ class_expr (//toplevel//[5,55+2]..[6,71+12])
+ Pcl_open Fresh "M" (//toplevel//[5,55+11]..[5,55+12])
+ class_expr (//toplevel//[6,71+2]..[6,71+12])
+ Pcl_structure
+ class_structure
+ pattern (//toplevel//[6,71+8]..[6,71+8]) ghost
+ Ppat_any
+ []
+ ]
+ ]
+
+class c : object end
+Ptop_def
+ [
+ structure_item (//toplevel//[2,1+0]..[4,33+12])
+ Pstr_class_type
+ [
+ class_type_declaration (//toplevel//[2,1+0]..[4,33+12])
+ pci_virt = Concrete
+ pci_params =
+ []
+ pci_name = "ct" (//toplevel//[2,1+11]..[2,1+13])
+ pci_expr =
+ class_type (//toplevel//[3,17+2]..[4,33+12])
+ Pcty_open Fresh "M" (//toplevel//[3,17+11]..[3,17+12])
+ class_type (//toplevel//[4,33+2]..[4,33+12])
+ Pcty_signature
+ class_signature
+ core_type (//toplevel//[4,33+8]..[4,33+8])
+ Ptyp_any
+ []
+ ]
+ ]
+
+class type ct = object end
+Ptop_def
+ [
+ structure_item (//toplevel//[5,56+0]..[6,64+4])
+ Pstr_value Nonrec
+ [
+ <def>
+ attribute "ocaml.doc"
+ [
+ structure_item (//toplevel//[4,19+0]..[4,19+36])
+ Pstr_eval
+ expression (//toplevel//[4,19+0]..[4,19+36])
+ Pexp_constant PConst_string(" Some docstring attached to x. ",(//toplevel//[4,19+0]..[4,19+36]),None)
+ ]
+ attribute "ocaml.doc"
+ [
+ structure_item (//toplevel//[7,69+0]..[7,69+39])
+ Pstr_eval
+ expression (//toplevel//[7,69+0]..[7,69+39])
+ Pexp_constant PConst_string(" Another docstring attached to x. ",(//toplevel//[7,69+0]..[7,69+39]),None)
+ ]
+ pattern (//toplevel//[5,56+4]..[5,56+5])
+ Ppat_var "x" (//toplevel//[5,56+4]..[5,56+5])
+ expression (//toplevel//[6,64+2]..[6,64+4])
+ Pexp_constant PConst_int (42,None)
+ ]
+ ]
+
+val x : int = 42
+
--- /dev/null
+(* TEST
+ flags = "-dparsetree"
+ * toplevel *)
+
+(* Using a toplevel test and not an expect test, because the locs get shifted
+ by the expect blocks and the output is therefore not stable. *)
+
+(* Attributes *)
+
+module type S = sig end [@attr payload];;
+
+
+module M = struct end [@attr payload];;
+
+type t = int [@attr payload];;
+
+3 [@attr payload];;
+
+exception Exn [@@attr payload];;
+
+(* Functors *)
+
+module type F = functor (A : S) (B : S) -> sig end;;
+
+module F = functor (A : S) (B : S) -> struct end;;
+
+(* with type *)
+
+module type S1 = sig type t end;;
+
+module type T1 = S1 with type t = int;;
+
+module type T1 = S1 with type t := int;;
+
+(* Constrained bindings *)
+
+let x : int = 3;;
+
+let x : type a. a -> a = fun x -> x;;
+
+let _ = object
+ method x : type a. a -> a =
+ fun x -> x
+end;;
+
+(* Punning. *)
+
+let x contents = { contents };;
+
+let x = { contents : int = 3 };;
+
+let x contents = { contents : int };;
+
+let x = function { contents } -> contents;;
+
+let x = function { contents : int } -> contents;;
+
+let x = function { contents : int = i } -> i;;
+
+(* Local open *)
+
+let x = M.{ contents = 3 };;
+
+let x = M.[ 3; 4 ];;
+
+let x = M.( 3; 4 );;
+
+(* Indexing operators *)
+
+ (* some prerequisites. *)
+
+let ( .@() ) x y = x + y
+let ( .@()<- ) x y z = x + y + z
+let ( .%.{} ) x y = x + y
+let ( .%.{}<- ) x y z = x + y + z
+let ( .%.[] ) x y = x + y
+let ( .%.[]<- ) x y z = x + y + z;;
+
+ (* the actual issue *)
+
+x.@(4);;
+x.@(4) <- 4;;
+
+x.%.{4};;
+x.%.{4} <- 4;;
+
+x.%.[4];;
+x.%.[4] <- 4;;
+
+(* Constrained unpacks *)
+
+let f = function (module M : S) -> ();;
+
+(* local opens in class and class types *)
+
+class c =
+ let open M in
+ object end
+;;
+
+class type ct =
+ let open M in
+ object end
+;;
+
+(* Docstrings *)
+
+(** Some docstring attached to x. *)
+let x =
+ 42
+(** Another docstring attached to x. *)
+;;
type%foo[@foo] t = int
and[@foo] t = int
type%foo[@foo] t += T
+type t += A = M.A[@a]
+type t += B = M.A[@b] | C = M.A[@c][@@t]
class%foo[@foo] x = x
class type%foo[@foo] x = x
external%foo[@foo] x : _ = ""
exception%foo[@foo] X
+exception A = M.A[@a]
module%foo[@foo] M = M
module%foo[@foo] rec M : S = M
let () =
f (fun (type t) -> x)
+
+(* #9778 *)
+
+type t = unit
+
+let rec equal : 'a. ('a -> 'a -> bool) -> 'a t -> 'a t -> bool =
+ (fun poly_a (_ : unit) (_ : unit) -> true) [@ocaml.warning "-A"]
+ [@@ocaml.warning "-39"]
+
+(* Issue #9548, PR #9591 *)
+
+type u = [ `A ] ;;
+type v = [ u | `B ] ;;
+let f = fun (x : [ | u ]) -> x ;;
+
+(* Issue #9999 *)
+let test = function
+ | `A | `B as x -> ignore x
+
+let test = function
+ | `A as x | (`B as x) -> ignore x
+
+let test = function
+ | `A as x | (`B as x) as z -> ignore (z, x)
+
+let test = function
+ | (`A as x) | (`B as x) as z -> ignore (z, x)
+
+let test = function
+ | (`A | `B) | `C -> ()
+
+let test = function
+ | `A | (`B | `C) -> ()
+
+let test = function
+ | `A | `B | `C -> ()
+
+let test = function
+ | (`A | `B) as x | `C -> ()
attribute "foo"
[]
ptyext_constructor =
- extension_constructor (attributes.ml[8,120+0]..[8,120+28])
+ extension_constructor (attributes.ml[8,120+0]..[8,120+20])
attribute "foo"
[]
pext_name = "Foo"
attribute "foo"
[]
ptyext_constructor =
- extension_constructor (attributes.ml[10,150+0]..[10,150+44])
+ extension_constructor (attributes.ml[10,150+0]..[10,150+36])
attribute "foo"
[]
pext_name = "Bar"
attribute "foo"
[]
ptyext_constructor =
- extension_constructor (attributes.ml[37,450+2]..[37,450+46])
+ extension_constructor (attributes.ml[37,450+2]..[37,450+38])
attribute "foo"
[]
pext_name = "Bar"
structure_item (attributes.ml[47,610+0]..[47,610+8])
Pstr_attribute "foo"
[]
+ structure_item (attributes.ml[49,620+0]..[49,620+30])
+ Pstr_modtype "T" (attributes.ml[49,620+12]..[49,620+13])
+ module_type (attributes.ml[49,620+16]..[49,620+30])
+ Pmty_signature
+ [
+ signature_item (attributes.ml[49,620+20]..[49,620+26])
+ Psig_type Rec
+ [
+ type_declaration "t" (attributes.ml[49,620+25]..[49,620+26]) (attributes.ml[49,620+20]..[49,620+26])
+ ptype_params =
+ []
+ ptype_cstrs =
+ []
+ ptype_kind =
+ Ptype_abstract
+ ptype_private = Public
+ ptype_manifest =
+ None
+ ]
+ ]
+ structure_item (attributes.ml[51,652+0]..[51,652+27])
+ Pstr_module
+ "_" (attributes.ml[51,652+7]..[51,652+8])
+ module_expr (attributes.ml[51,652+11]..[51,652+27])
+ Pmod_constraint
+ module_expr (attributes.ml[51,652+12]..[51,652+15])
+ Pmod_ident "Int" (attributes.ml[51,652+12]..[51,652+15])
+ module_type (attributes.ml[51,652+18]..[51,652+19])
+ attribute "foo"
+ []
+ Pmty_ident "T" (attributes.ml[51,652+18]..[51,652+19])
+ structure_item (attributes.ml[53,681+0]..[53,681+45])
+ Pstr_module
+ "_" (attributes.ml[53,681+7]..[53,681+8])
+ module_expr (attributes.ml[53,681+11]..[53,681+45])
+ Pmod_constraint
+ module_expr (attributes.ml[53,681+12]..[53,681+15])
+ Pmod_ident "Int" (attributes.ml[53,681+12]..[53,681+15])
+ module_type (attributes.ml[53,681+18]..[53,681+37])
+ attribute "foo"
+ []
+ Pmty_with
+ module_type (attributes.ml[53,681+18]..[53,681+19])
+ Pmty_ident "T" (attributes.ml[53,681+18]..[53,681+19])
+ [
+ Pwith_type "t" (attributes.ml[53,681+30]..[53,681+31])
+ type_declaration "t" (attributes.ml[53,681+30]..[53,681+31]) (attributes.ml[53,681+25]..[53,681+37])
+ ptype_params =
+ []
+ ptype_cstrs =
+ []
+ ptype_kind =
+ Ptype_abstract
+ ptype_private = Public
+ ptype_manifest =
+ Some
+ core_type (attributes.ml[53,681+34]..[53,681+37])
+ Ptyp_constr "int" (attributes.ml[53,681+34]..[53,681+37])
+ []
+ ]
+ structure_item (attributes.ml[55,728+0]..[55,728+31])
+ Pstr_value Nonrec
+ [
+ <def>
+ pattern (attributes.ml[55,728+4]..[55,728+5])
+ Ppat_any
+ expression (attributes.ml[55,728+8]..[55,728+31])
+ Pexp_constraint
+ expression (attributes.ml[55,728+8]..[55,728+31]) ghost
+ Pexp_pack
+ module_expr (attributes.ml[55,728+16]..[55,728+19])
+ Pmod_ident "Int" (attributes.ml[55,728+16]..[55,728+19])
+ core_type (attributes.ml[55,728+22]..[55,728+30])
+ attribute "foo"
+ []
+ Ptyp_package "T" (attributes.ml[55,728+22]..[55,728+23])
+ []
+ ]
+ structure_item (attributes.ml[57,761+0]..[57,761+49])
+ Pstr_value Nonrec
+ [
+ <def>
+ pattern (attributes.ml[57,761+4]..[57,761+5])
+ Ppat_any
+ expression (attributes.ml[57,761+8]..[57,761+49])
+ Pexp_constraint
+ expression (attributes.ml[57,761+8]..[57,761+49]) ghost
+ Pexp_pack
+ module_expr (attributes.ml[57,761+16]..[57,761+19])
+ Pmod_ident "Int" (attributes.ml[57,761+16]..[57,761+19])
+ core_type (attributes.ml[57,761+22]..[57,761+48])
+ attribute "foo"
+ []
+ Ptyp_package "T" (attributes.ml[57,761+22]..[57,761+23])
+ [
+ with type "t" (attributes.ml[57,761+34]..[57,761+35])
+ core_type (attributes.ml[57,761+38]..[57,761+41])
+ Ptyp_constr "int" (attributes.ml[57,761+38]..[57,761+41])
+ []
+ ]
+ ]
]
[@@foo]
[@@@foo]
+
+module type T = sig type t end
+
+module _ = (Int : T [@foo])
+
+module _ = (Int : T with type t = int [@foo])
+
+let _ = (module Int : T [@foo])
+
+let _ = (module Int : T with type t = int [@foo])
--- /dev/null
+(* TEST
+ * expect
+*)
+
+let f o x = o##x;;
+[%%expect {|
+Line 1, characters 13-15:
+1 | let f o x = o##x;;
+ ^^
+Error: '##' is not a valid value identifier.
+|}]
+
+let f x = !#x
+[%%expect {|
+Line 1, characters 10-12:
+1 | let f x = !#x
+ ^^
+Error: '!#' is not a valid value identifier.
+|}]
+
+let f x = ?#x
+[%%expect {|
+Line 1, characters 10-12:
+1 | let f x = ?#x
+ ^^
+Error: '?#' is not a valid value identifier.
+|}]
+
+let f x = ~#x
+[%%expect {|
+Line 1, characters 10-12:
+1 | let f x = ~#x
+ ^^
+Error: '~#' is not a valid value identifier.
+|}]
+
+let f o x = o#-#x
+[%%expect {|
+Line 1, characters 13-16:
+1 | let f o x = o#-#x
+ ^^^
+Error: '#-#' is not a valid value identifier.
+|}]
+
+let f x = !-#x
+[%%expect {|
+Line 1, characters 10-13:
+1 | let f x = !-#x
+ ^^^
+Error: '!-#' is not a valid value identifier.
+|}]
+
+let f x = ?-#x
+[%%expect {|
+Line 1, characters 10-13:
+1 | let f x = ?-#x
+ ^^^
+Error: '?-#' is not a valid value identifier.
+|}]
+
+let f x = ~-#x
+[%%expect {|
+Line 1, characters 10-13:
+1 | let f x = ~-#x
+ ^^^
+Error: '~-#' is not a valid value identifier.
+|}]
pattern (extensions.ml[20,445+54]..[20,445+59])
Ppat_record Closed
[
- "x" (extensions.ml[20,445+56]..[20,445+57])
+ "x" (extensions.ml[20,445+56]..[20,445+57]) ghost
pattern (extensions.ml[20,445+56]..[20,445+57])
Ppat_var "x" (extensions.ml[20,445+56]..[20,445+57])
]
structure_item (shortcut_ext_attr.ml[64,1353+0]..[67,1409+22])
Pstr_module
"M" (shortcut_ext_attr.ml[64,1353+7]..[64,1353+8])
- module_expr (shortcut_ext_attr.ml[65,1364+2]..[67,1409+22])
+ module_expr (shortcut_ext_attr.ml[65,1364+16]..[67,1409+22])
attribute "foo"
[]
Pmod_functor "M" (shortcut_ext_attr.ml[65,1364+17]..[65,1364+18])
[]
structure_item (shortcut_ext_attr.ml[70,1462+0]..[73,1535+19])
Pstr_modtype "S" (shortcut_ext_attr.ml[70,1462+12]..[70,1462+13])
- module_type (shortcut_ext_attr.ml[71,1478+2]..[73,1535+19])
+ module_type (shortcut_ext_attr.ml[71,1478+16]..[73,1535+19])
attribute "foo"
[]
Pmty_functor "M" (shortcut_ext_attr.ml[71,1478+17]..[71,1478+18])
[%%expect {|
Line 1:
Error: Type declarations do not match:
- type 'a x = private [> `x ] constraint 'a = 'a x
+ type !'a x = private [> `x ] constraint 'a = 'a x
is not included in
type 'a x
Their constraints differ.
|}, Principal{|
Line 1:
Error: Type declarations do not match:
- type 'a x = private 'a constraint 'a = [> `x ]
+ type !'a x = private 'a constraint 'a = [> `x ]
is not included in
type 'a x
Their constraints differ.
** ocamlc.byte
compile_only = "true"
module = "cmis_on_file_system.ml"
- flags="-bin-annot"
+ flags="-bin-annot -no-alias-deps -w '-49'"
*** script
script= "mv cmis_on_file_system.cmt lone.cmt"
**** ocamlc.byte
compile_only="true"
***** ocamlc.byte
compile_only = "true"
- flags="-bin-annot"
+ flags="-bin-annot -no-alias-deps -w '-49'"
module="cmis_on_file_system.ml"
- ****** compare-native-programs
+ ****** compare-binary-files
program="cmis_on_file_system.cmt"
program2="lone.cmt"
*)
at a given point in time *)
type t = int
let () = ()
+
+module M = Cmis_on_file_system_companion
--- /dev/null
+#include <string.h>
+#include "caml/mlvalues.h"
+#include "caml/gc.h"
+#include "caml/memory.h"
+
+static int colors[4] = { Caml_white, Caml_gray, Caml_blue, Caml_black };
+
+value make_block(value header_size, value color, value size)
+{
+ intnat sz = Nativeint_val(size);
+ value * p = caml_stat_alloc((1 + sz) * sizeof(value));
+ p[0] = Make_header(Nativeint_val(header_size), 0, colors[Int_val(color)]);
+ memset(p + 1, 0x80, sz * sizeof(value));
+ return (value) (p + 1);
+}
+
+value make_raw_pointer (value v)
+{
+ return (value) Nativeint_val(v);
+}
--- /dev/null
+type color = White | Gray | Blue | Black
+
+external make_block: nativeint -> color -> nativeint -> Obj.t
+ = "make_block"
+
+external make_raw_pointer: nativeint -> Obj.t
+ = "make_raw_pointer"
+
+let do_gc root =
+ Gc.compact(); (* full major + compaction *)
+ root
--- /dev/null
+(* TEST
+ modules = "cstubs.c np.ml"
+ * bytecode
+ * native
+*)
+
+open Np
+
+(* Out-of-heap object with black header is accepted even in no-naked-pointers
+ mode. GC doesn't scan black objects. *)
+
+let x = do_gc [ make_block 100n Black 100n ]
--- /dev/null
+(* TEST
+ modules = "cstubs.c np.ml"
+ * bytecode
+ * native
+*)
+
+open Np
+
+(* Out-of-heap object with black header is accepted even in no-naked-pointers
+ mode. GC doesn't scan black objects. However, if the size in the
+ head is crazily big, the naked pointer detector will warn. *)
+
+let x = do_gc [ make_block (-1n) Black 100n ]
--- /dev/null
+#!/bin/sh
+
+exec ${test_source_directory}/runtest.sh
--- /dev/null
+(* TEST
+ modules = "cstubs.c np.ml"
+ * naked_pointers
+ ** bytecode
+ ** native
+*)
+
+open Np
+
+(* Out-of-heap object with non-black header is OK in naked pointers mode only *)
+(* Note that the header size can be wrong as it should not be used by the GC *)
+
+let x = do_gc [ make_block 10000n White 10n;
+ make_block 1n Blue 0n;
+ make_block (-1n) Gray 5n ]
--- /dev/null
+#!/bin/sh
+
+exec ${test_source_directory}/runtest.sh
--- /dev/null
+(* TEST
+ modules = "cstubs.c np.ml"
+ * naked_pointers
+ ** bytecode
+ ** native
+*)
+
+open Np
+
+(* Null pointers and bad pointers outside the heap are OK
+ in naked pointers mode only *)
+
+let x = do_gc [ make_raw_pointer 0n; make_raw_pointer 42n ]
--- /dev/null
+#!/bin/sh
+
+exec ${test_source_directory}/runtest.sh
--- /dev/null
+#!/bin/sh
+
+if grep -q "#define NAKED_POINTERS_CHECKER" ${ocamlsrcdir}/runtime/caml/m.h \
+&& (echo ${program} | grep -q '\.opt')
+then
+ (${program} > ${output}) 2>&1 | grep -q '^Out-of-heap '
+ exit $?
+else
+ exec ${program} > ${output}
+fi
Env.add_persistent_structure (Ident.create_persistent "Foo")
!Toploop.toplevel_env
| _ -> ());
- Topmain.main ()
+ exit (Topmain.main ())
Line 4, characters 2-11:
4 | include S
^^^^^^^^^
-Error: Illegal shadowing of included type t/144 by t/161
+Error: Illegal shadowing of included type t/146 by t/163
Line 2, characters 2-11:
- Type t/144 came from this include
+ Type t/146 came from this include
Line 3, characters 2-24:
- The value ignore has no valid type if t/144 is shadowed
+ The value ignore has no valid type if t/146 is shadowed
|}]
module type Module = sig
Line 4, characters 2-11:
4 | include S
^^^^^^^^^
-Error: Illegal shadowing of included module M/232 by M/249
+Error: Illegal shadowing of included module M/237 by M/254
Line 2, characters 2-11:
- Module M/232 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/232 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/317 by T/334
+Error: Illegal shadowing of included module type T/324 by T/341
Line 2, characters 2-11:
- Module type T/317 came from this include
+ Module type T/324 came from this include
Line 3, characters 2-39:
- The module F has no valid type if T/317 is shadowed
+ The module F has no valid type if T/324 is shadowed
|}]
module type Extension = sig
Line 4, characters 2-11:
4 | include S
^^^^^^^^^
-Error: Illegal shadowing of included type ext/352 by ext/369
+Error: Illegal shadowing of included type ext/360 by ext/377
Line 2, characters 2-11:
- Type ext/352 came from this include
+ Type ext/360 came from this include
Line 3, characters 14-16:
- The extension constructor C2 has no valid type if ext/352 is shadowed
+ The extension constructor C2 has no valid type if ext/360 is shadowed
|}]
module type Class = sig
--- /dev/null
+(* TEST *)
+module MP = Gc.Memprof
+
+let allocs_by_memprof f =
+ let minor = ref 0 in
+ let major = ref 0 in
+ let alloc_minor (info : MP.allocation) =
+ minor := !minor + info.n_samples;
+ None in
+ let alloc_major (info : MP.allocation) =
+ major := !major + info.n_samples;
+ None in
+ MP.start ~sampling_rate:1. ({MP.null_tracker with alloc_minor; alloc_major});
+ match Sys.opaque_identity f () with
+ | _ -> MP.stop (); (!minor, !major)
+ | exception e -> MP.stop (); raise e
+
+let allocs_by_counters f =
+ let minor1, prom1, major1 = Gc.counters () in
+ let minor2, prom2, major2 = Gc.counters () in
+ ignore (Sys.opaque_identity f ());
+ let minor3, prom3, major3 = Gc.counters () in
+ let minor =
+ minor3 -. minor2 (* allocations *)
+ -. (minor2 -. minor1) (* Gc.counters overhead *)
+ in
+ let prom =
+ prom3 -. prom2 -. (prom2 -. prom1) in
+ let major =
+ major3 -. major2 -. (major2 -. major1) in
+ int_of_float minor,
+ int_of_float (major -. prom)
+
+let compare name f =
+ let mp_minor, mp_major = allocs_by_memprof f in
+ let ct_minor, ct_major = allocs_by_counters f in
+ if mp_minor <> ct_minor || mp_major <> ct_major then
+ Printf.printf "%20s: minor: %d / %d; major: %d / %d\n"
+ name ct_minor mp_minor ct_major mp_major
+
+let many f =
+ fun () ->
+ for i = 1 to 10 do
+ ignore (Sys.opaque_identity f ())
+ done
+
+let () =
+ compare "ref" (many (fun () -> ref (ref (ref 42))));
+ compare "short array" (many (fun () -> Array.make 10 'a'));
+ compare "long array" (many (fun () -> Array.make 1000 'a'));
+ compare "curried closure" (many (fun () -> fun a b -> a + b));
+ compare "marshalling" (many (fun () ->
+ Marshal.from_string (Marshal.to_string (ref (ref (ref 42))) []) 0))
(* TEST
flags = "-g"
- compare_programs = "false"
*)
open Gc.Memprof
alloc_major = (fun info ->
assert (info.size >= lo && info.size <= hi);
assert (info.n_samples > 0);
- assert (not info.unmarshalled);
+ assert (info.source = Normal);
smp := !smp + info.n_samples;
None
);
(* TEST
flags = "-g"
- compare_programs = "false"
*)
open Gc.Memprof
alloc_minor = (fun info ->
assert (info.size >= lo && info.size <= hi);
assert (info.n_samples > 0);
- assert (not info.unmarshalled);
+ assert (info.source = Normal);
smp := !smp + info.n_samples;
None
);
*)
let cnt = ref 0
-let alloc_num = ref 0
-let alloc_tot = 100000
+let alloc_thread = 50000
let (rd1, wr1) = Unix.pipe ()
let (rd2, wr2) = Unix.pipe ()
let main_thread = Thread.self ()
let cb_main = ref 0 and cb_other = ref 0
let stopped = ref false
-let minor_alloc_callback _ =
+let alloc_callback alloc =
if !stopped then
None
else begin
- let do_stop = !cb_main + !cb_other >= alloc_tot in
- if do_stop then stopped := true;
let t = Thread.self () in
if t == main_thread then begin
+ assert (alloc.Gc.Memprof.size < 10 || alloc.Gc.Memprof.size mod 2 = 0);
+ let do_stop = !cb_main >= alloc_thread in
+ if do_stop then stopped := true;
incr cb_main;
+
assert (Unix.write wr2 (Bytes.make 1 'a') 0 1 = 1);
if not do_stop then
assert (Unix.read rd1 (Bytes.make 1 'a') 0 1 = 1)
end else begin
+ assert (alloc.Gc.Memprof.size < 10 || alloc.Gc.Memprof.size mod 2 = 1);
+ let do_stop = !cb_other >= alloc_thread in
+ if do_stop then stopped := true;
incr cb_other;
+
assert (Unix.write wr1 (Bytes.make 1 'a') 0 1 = 1);
if not do_stop then
assert (Unix.read rd2 (Bytes.make 1 'a') 0 1 = 1)
let mut = Mutex.create ()
let () = Mutex.lock mut
-let rec go () =
+let rec go alloc_num tid =
Mutex.lock mut;
Mutex.unlock mut;
- if !alloc_num < alloc_tot then begin
- alloc_num := !alloc_num + 1;
- Sys.opaque_identity (Bytes.make (Random.int 300) 'a') |> ignore;
- go ()
+ if alloc_num < alloc_thread then begin
+ let len = 2 * (Random.int 200 + 1) + tid in
+ Sys.opaque_identity (Array.make len 0) |> ignore;
+ go (alloc_num + 1) tid
end else begin
cnt := !cnt + 1;
if !cnt < 2 then begin
Gc.minor (); (* check for callbacks *)
Thread.yield ();
- go ()
+ go alloc_num tid
end else begin
Gc.minor () (* check for callbacks *)
end
end
let () =
- let t = Thread.create go () in
+ let t = Thread.create (fun () -> go 0 1) () in
Gc.Memprof.(start ~callstack_size:10 ~sampling_rate:1.
- { null_tracker with alloc_minor = minor_alloc_callback; });
+ { null_tracker with
+ alloc_minor = alloc_callback;
+ alloc_major = alloc_callback });
Mutex.unlock mut;
- go ();
+ go 0 0;
Thread.join t;
Gc.Memprof.stop ();
- assert (abs (!cb_main - !cb_other) <= 1);
- assert (!cb_main + !cb_other >= alloc_tot)
+ assert (!cb_main >= alloc_thread);
+ assert (!cb_other >= alloc_thread);
+ assert (abs (!cb_main - !cb_other) <= 1)
-----------
-Raised by primitive operation at Callstacks.alloc_list_literal in file "callstacks.ml", line 21, characters 30-53
-Called from Callstacks.test in file "callstacks.ml", line 95, characters 2-10
+Raised by primitive operation at Callstacks.alloc_list_literal in file "callstacks.ml", line 18, characters 30-53
+Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Callstacks in file "callstacks.ml", line 102, characters 2-27
+Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
-Raised by primitive operation at Callstacks.alloc_pair in file "callstacks.ml", line 24, characters 30-76
-Called from Callstacks.test in file "callstacks.ml", line 95, characters 2-10
+Raised by primitive operation at Callstacks.alloc_pair in file "callstacks.ml", line 21, characters 30-76
+Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Callstacks in file "callstacks.ml", line 102, characters 2-27
+Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
-Raised by primitive operation at Callstacks.alloc_record in file "callstacks.ml", line 29, characters 12-66
-Called from Callstacks.test in file "callstacks.ml", line 95, characters 2-10
+Raised by primitive operation at Callstacks.alloc_record in file "callstacks.ml", line 26, characters 12-66
+Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Callstacks in file "callstacks.ml", line 102, characters 2-27
+Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
-Raised by primitive operation at Callstacks.alloc_some in file "callstacks.ml", line 32, characters 30-60
-Called from Callstacks.test in file "callstacks.ml", line 95, characters 2-10
+Raised by primitive operation at Callstacks.alloc_some in file "callstacks.ml", line 29, characters 30-60
+Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Callstacks in file "callstacks.ml", line 102, characters 2-27
+Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
-Raised by primitive operation at Callstacks.alloc_array_literal in file "callstacks.ml", line 35, characters 30-55
-Called from Callstacks.test in file "callstacks.ml", line 95, characters 2-10
+Raised by primitive operation at Callstacks.alloc_array_literal in file "callstacks.ml", line 32, characters 30-55
+Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Callstacks in file "callstacks.ml", line 102, characters 2-27
+Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
-Raised by primitive operation at Callstacks.alloc_float_array_literal in file "callstacks.ml", line 39, characters 12-62
-Called from Callstacks.test in file "callstacks.ml", line 95, characters 2-10
+Raised by primitive operation at Callstacks.alloc_float_array_literal in file "callstacks.ml", line 36, characters 12-62
+Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Callstacks in file "callstacks.ml", line 102, characters 2-27
+Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
-Raised by primitive operation at Callstacks.do_alloc_unknown_array_literal in file "callstacks.ml", line 42, characters 22-27
-Called from Callstacks.alloc_unknown_array_literal in file "callstacks.ml", line 44, characters 30-65
-Called from Callstacks.test in file "callstacks.ml", line 95, characters 2-10
+Raised by primitive operation at Callstacks.do_alloc_unknown_array_literal in file "callstacks.ml", line 39, characters 22-27
+Called from Callstacks.alloc_unknown_array_literal in file "callstacks.ml", line 41, characters 30-65
+Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Callstacks in file "callstacks.ml", line 102, characters 2-27
+Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
-Raised by primitive operation at Callstacks.alloc_small_array in file "callstacks.ml", line 47, characters 30-69
-Called from Callstacks.test in file "callstacks.ml", line 95, characters 2-10
+Raised by primitive operation at Callstacks.alloc_small_array in file "callstacks.ml", line 44, characters 30-69
+Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Callstacks in file "callstacks.ml", line 102, characters 2-27
+Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
-Raised by primitive operation at Callstacks.alloc_large_array in file "callstacks.ml", line 50, characters 30-73
-Called from Callstacks.test in file "callstacks.ml", line 95, characters 2-10
+Raised by primitive operation at Callstacks.alloc_large_array in file "callstacks.ml", line 47, characters 30-73
+Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Callstacks in file "callstacks.ml", line 102, characters 2-27
+Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
-Raised by primitive operation at Callstacks.alloc_closure.(fun) in file "callstacks.ml", line 54, characters 30-43
-Called from Callstacks.test in file "callstacks.ml", line 95, characters 2-10
+Raised by primitive operation at Callstacks.alloc_closure.(fun) in file "callstacks.ml", line 51, characters 30-43
+Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Callstacks in file "callstacks.ml", line 102, characters 2-27
+Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
-Raised by primitive operation at Callstacks.get0 in file "callstacks.ml", line 57, characters 28-33
-Called from Callstacks.getfloatfield in file "callstacks.ml", line 59, characters 30-47
-Called from Callstacks.test in file "callstacks.ml", line 95, characters 2-10
+Raised by primitive operation at Callstacks.get0 in file "callstacks.ml", line 54, characters 28-33
+Called from Callstacks.getfloatfield in file "callstacks.ml", line 56, characters 30-47
+Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Callstacks in file "callstacks.ml", line 102, characters 2-27
+Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
Raised by primitive operation at Stdlib__marshal.from_bytes in file "marshal.ml", line 61, characters 9-35
-Called from Callstacks.alloc_unmarshal in file "callstacks.ml", line 65, characters 12-87
-Called from Callstacks.test in file "callstacks.ml", line 95, characters 2-10
+Called from Callstacks.alloc_unmarshal in file "callstacks.ml", line 62, characters 12-87
+Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Callstacks in file "callstacks.ml", line 102, characters 2-27
+Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
-Raised by primitive operation at Callstacks.alloc_ref in file "callstacks.ml", line 68, characters 30-59
-Called from Callstacks.test in file "callstacks.ml", line 95, characters 2-10
+Raised by primitive operation at Callstacks.alloc_ref in file "callstacks.ml", line 65, characters 30-59
+Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Callstacks in file "callstacks.ml", line 102, characters 2-27
+Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
-Raised by primitive operation at Callstacks.prod_floats in file "callstacks.ml", line 71, characters 37-43
-Called from Callstacks.alloc_boxedfloat in file "callstacks.ml", line 73, characters 30-49
-Called from Callstacks.test in file "callstacks.ml", line 95, characters 2-10
+Raised by primitive operation at Callstacks.prod_floats in file "callstacks.ml", line 68, characters 37-43
+Called from Callstacks.alloc_boxedfloat in file "callstacks.ml", line 70, characters 30-49
+Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Callstacks in file "callstacks.ml", line 102, characters 2-27
+Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
(* TEST
flags = "-g -w -5"
- compare_programs = "false"
- * no-spacetime
+ * flat-float-array
+ reference = "${test_source_directory}/callstacks.flat-float-array.reference"
+ ** native
+ ** bytecode
- ** flat-float-array
- reference = "${test_source_directory}/callstacks.flat-float-array.reference"
- *** native
- *** bytecode
-
- ** no-flat-float-array
- reference = "${test_source_directory}/callstacks.no-flat-float-array.reference"
- *** native
- *** bytecode
+ * no-flat-float-array
+ reference = "${test_source_directory}/callstacks.no-flat-float-array.reference"
+ ** native
+ ** bytecode
*)
open Gc.Memprof
-----------
-Raised by primitive operation at Callstacks.alloc_list_literal in file "callstacks.ml", line 21, characters 30-53
-Called from Callstacks.test in file "callstacks.ml", line 95, characters 2-10
+Raised by primitive operation at Callstacks.alloc_list_literal in file "callstacks.ml", line 18, characters 30-53
+Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Callstacks in file "callstacks.ml", line 102, characters 2-27
+Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
-Raised by primitive operation at Callstacks.alloc_pair in file "callstacks.ml", line 24, characters 30-76
-Called from Callstacks.test in file "callstacks.ml", line 95, characters 2-10
+Raised by primitive operation at Callstacks.alloc_pair in file "callstacks.ml", line 21, characters 30-76
+Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Callstacks in file "callstacks.ml", line 102, characters 2-27
+Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
-Raised by primitive operation at Callstacks.alloc_record in file "callstacks.ml", line 29, characters 12-66
-Called from Callstacks.test in file "callstacks.ml", line 95, characters 2-10
+Raised by primitive operation at Callstacks.alloc_record in file "callstacks.ml", line 26, characters 12-66
+Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Callstacks in file "callstacks.ml", line 102, characters 2-27
+Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
-Raised by primitive operation at Callstacks.alloc_some in file "callstacks.ml", line 32, characters 30-60
-Called from Callstacks.test in file "callstacks.ml", line 95, characters 2-10
+Raised by primitive operation at Callstacks.alloc_some in file "callstacks.ml", line 29, characters 30-60
+Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Callstacks in file "callstacks.ml", line 102, characters 2-27
+Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
-Raised by primitive operation at Callstacks.alloc_array_literal in file "callstacks.ml", line 35, characters 30-55
-Called from Callstacks.test in file "callstacks.ml", line 95, characters 2-10
+Raised by primitive operation at Callstacks.alloc_array_literal in file "callstacks.ml", line 32, characters 30-55
+Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Callstacks in file "callstacks.ml", line 102, characters 2-27
+Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
-Raised by primitive operation at Callstacks.alloc_float_array_literal in file "callstacks.ml", line 39, characters 12-62
-Called from Callstacks.test in file "callstacks.ml", line 95, characters 2-10
+Raised by primitive operation at Callstacks.alloc_float_array_literal in file "callstacks.ml", line 36, characters 12-62
+Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Callstacks in file "callstacks.ml", line 102, characters 2-27
+Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
-Raised by primitive operation at Callstacks.do_alloc_unknown_array_literal in file "callstacks.ml", line 42, characters 22-27
-Called from Callstacks.alloc_unknown_array_literal in file "callstacks.ml", line 44, characters 30-65
-Called from Callstacks.test in file "callstacks.ml", line 95, characters 2-10
+Raised by primitive operation at Callstacks.do_alloc_unknown_array_literal in file "callstacks.ml", line 39, characters 22-27
+Called from Callstacks.alloc_unknown_array_literal in file "callstacks.ml", line 41, characters 30-65
+Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Callstacks in file "callstacks.ml", line 102, characters 2-27
+Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
-Raised by primitive operation at Callstacks.alloc_small_array in file "callstacks.ml", line 47, characters 30-69
-Called from Callstacks.test in file "callstacks.ml", line 95, characters 2-10
+Raised by primitive operation at Callstacks.alloc_small_array in file "callstacks.ml", line 44, characters 30-69
+Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Callstacks in file "callstacks.ml", line 102, characters 2-27
+Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
-Raised by primitive operation at Callstacks.alloc_large_array in file "callstacks.ml", line 50, characters 30-73
-Called from Callstacks.test in file "callstacks.ml", line 95, characters 2-10
+Raised by primitive operation at Callstacks.alloc_large_array in file "callstacks.ml", line 47, characters 30-73
+Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Callstacks in file "callstacks.ml", line 102, characters 2-27
+Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
-Raised by primitive operation at Callstacks.alloc_closure.(fun) in file "callstacks.ml", line 54, characters 30-43
-Called from Callstacks.test in file "callstacks.ml", line 95, characters 2-10
+Raised by primitive operation at Callstacks.alloc_closure.(fun) in file "callstacks.ml", line 51, characters 30-43
+Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Callstacks in file "callstacks.ml", line 102, characters 2-27
+Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
No callstack
-----------
Raised by primitive operation at Stdlib__marshal.from_bytes in file "marshal.ml", line 61, characters 9-35
-Called from Callstacks.alloc_unmarshal in file "callstacks.ml", line 65, characters 12-87
-Called from Callstacks.test in file "callstacks.ml", line 95, characters 2-10
+Called from Callstacks.alloc_unmarshal in file "callstacks.ml", line 62, characters 12-87
+Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Callstacks in file "callstacks.ml", line 102, characters 2-27
+Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
-Raised by primitive operation at Callstacks.alloc_ref in file "callstacks.ml", line 68, characters 30-59
-Called from Callstacks.test in file "callstacks.ml", line 95, characters 2-10
+Raised by primitive operation at Callstacks.alloc_ref in file "callstacks.ml", line 65, characters 30-59
+Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Callstacks in file "callstacks.ml", line 102, characters 2-27
+Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
-Raised by primitive operation at Callstacks.prod_floats in file "callstacks.ml", line 71, characters 37-43
-Called from Callstacks.alloc_boxedfloat in file "callstacks.ml", line 73, characters 30-49
-Called from Callstacks.test in file "callstacks.ml", line 95, characters 2-10
+Raised by primitive operation at Callstacks.prod_floats in file "callstacks.ml", line 68, characters 37-43
+Called from Callstacks.alloc_boxedfloat in file "callstacks.ml", line 70, characters 30-49
+Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Callstacks in file "callstacks.ml", line 102, characters 2-27
+Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
2: 0.42 false
-Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 16, characters 2-19
-Called from Comballoc.test in file "comballoc.ml", line 41, characters 25-48
+Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 2-19
+Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 71, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
3: 0.42 false
-Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 16, characters 6-18
-Called from Comballoc.test in file "comballoc.ml", line 41, characters 25-48
+Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 6-18
+Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 71, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
4: 0.42 true
-Raised by primitive operation at Comballoc.f4 in file "comballoc.ml", line 13, characters 11-20
-Called from Comballoc.f in file "comballoc.ml", line 16, characters 13-17
-Called from Comballoc.test in file "comballoc.ml", line 41, characters 25-48
+Raised by primitive operation at Comballoc.f4 in file "comballoc.ml", line 11, characters 11-20
+Called from Comballoc.f in file "comballoc.ml", line 14, characters 13-17
+Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 71, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
2: 0.01 false
-Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 16, characters 2-19
-Called from Comballoc.test in file "comballoc.ml", line 41, characters 25-48
+Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 2-19
+Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 71, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
3: 0.01 false
-Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 16, characters 6-18
-Called from Comballoc.test in file "comballoc.ml", line 41, characters 25-48
+Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 6-18
+Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 71, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
4: 0.01 true
-Raised by primitive operation at Comballoc.f4 in file "comballoc.ml", line 13, characters 11-20
-Called from Comballoc.f in file "comballoc.ml", line 16, characters 13-17
-Called from Comballoc.test in file "comballoc.ml", line 41, characters 25-48
+Raised by primitive operation at Comballoc.f4 in file "comballoc.ml", line 11, characters 11-20
+Called from Comballoc.f in file "comballoc.ml", line 14, characters 13-17
+Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 71, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
2: 0.83 false
-Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 16, characters 2-19
-Called from Comballoc.test in file "comballoc.ml", line 41, characters 25-48
+Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 2-19
+Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 71, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
3: 0.83 false
-Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 16, characters 6-18
-Called from Comballoc.test in file "comballoc.ml", line 41, characters 25-48
+Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 6-18
+Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 71, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
4: 0.83 true
-Raised by primitive operation at Comballoc.f4 in file "comballoc.ml", line 13, characters 11-20
-Called from Comballoc.f in file "comballoc.ml", line 16, characters 13-17
-Called from Comballoc.test in file "comballoc.ml", line 41, characters 25-48
+Raised by primitive operation at Comballoc.f4 in file "comballoc.ml", line 11, characters 11-20
+Called from Comballoc.f in file "comballoc.ml", line 14, characters 13-17
+Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 71, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
OK
(* TEST
flags = "-g"
- * no-spacetime
- ** bytecode
- reference = "${test_source_directory}/comballoc.byte.reference"
- ** native
- reference = "${test_source_directory}/comballoc.opt.reference"
- compare_programs = "false"
+ * bytecode
+ reference = "${test_source_directory}/comballoc.byte.reference"
+ * native
+ reference = "${test_source_directory}/comballoc.opt.reference"
*)
open Gc.Memprof
2: 0.42 false
-Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 16, characters 2-19
-Called from Comballoc.test in file "comballoc.ml", line 41, characters 25-48
+Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 2-19
+Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 71, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
3: 0.42 false
-Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 16, characters 6-18
-Called from Comballoc.test in file "comballoc.ml", line 41, characters 25-48
+Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 6-18
+Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 71, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
4: 0.42 true
-Raised by primitive operation at Comballoc.f4 in file "comballoc.ml" (inlined), line 13, characters 11-20
-Called from Comballoc.f in file "comballoc.ml", line 16, characters 13-17
-Called from Comballoc.test in file "comballoc.ml", line 41, characters 25-48
+Raised by primitive operation at Comballoc.f4 in file "comballoc.ml" (inlined), line 11, characters 11-20
+Called from Comballoc.f in file "comballoc.ml", line 14, characters 13-17
+Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 71, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
2: 0.01 false
-Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 16, characters 2-19
-Called from Comballoc.test in file "comballoc.ml", line 41, characters 25-48
+Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 2-19
+Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 71, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
3: 0.01 false
-Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 16, characters 6-18
-Called from Comballoc.test in file "comballoc.ml", line 41, characters 25-48
+Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 6-18
+Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 71, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
4: 0.01 true
-Raised by primitive operation at Comballoc.f4 in file "comballoc.ml" (inlined), line 13, characters 11-20
-Called from Comballoc.f in file "comballoc.ml", line 16, characters 13-17
-Called from Comballoc.test in file "comballoc.ml", line 41, characters 25-48
+Raised by primitive operation at Comballoc.f4 in file "comballoc.ml" (inlined), line 11, characters 11-20
+Called from Comballoc.f in file "comballoc.ml", line 14, characters 13-17
+Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 71, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
2: 0.83 false
-Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 16, characters 2-19
-Called from Comballoc.test in file "comballoc.ml", line 41, characters 25-48
+Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 2-19
+Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 71, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
3: 0.83 false
-Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 16, characters 6-18
-Called from Comballoc.test in file "comballoc.ml", line 41, characters 25-48
+Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 6-18
+Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 71, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
4: 0.83 true
-Raised by primitive operation at Comballoc.f4 in file "comballoc.ml" (inlined), line 13, characters 11-20
-Called from Comballoc.f in file "comballoc.ml", line 16, characters 13-17
-Called from Comballoc.test in file "comballoc.ml", line 41, characters 25-48
+Raised by primitive operation at Comballoc.f4 in file "comballoc.ml" (inlined), line 11, characters 11-20
+Called from Comballoc.f in file "comballoc.ml", line 14, characters 13-17
+Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 71, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
OK
--- /dev/null
+(* TEST *)
+
+open Gc.Memprof
+
+let bigstring_create sz =
+ Bigarray.Array1.create Bigarray.char Bigarray.c_layout sz
+
+let keep = ref []
+
+let test sampling_rate =
+ let size = 256 in
+ let iters = 100_000 in
+ let size_words = size / (Sys.word_size / 8) in
+ let alloc = ref 0 and collect = ref 0 and promote = ref 0 in
+ let tracker =
+ { null_tracker with
+ alloc_minor = (fun info ->
+ if info.source <> Custom then None
+ else begin
+ alloc := !alloc + info.n_samples;
+ Some info.n_samples
+ end);
+ promote = (fun ns ->
+ promote := !promote + ns; None);
+ dealloc_minor = (fun ns ->
+ collect := !collect + ns) } in
+ start ~sampling_rate tracker;
+ for i = 1 to iters do
+ let str = Sys.opaque_identity bigstring_create size in
+ if i mod 10 = 0 then keep := str :: !keep
+ done;
+ keep := [];
+ Gc.full_major ();
+ stop ();
+ assert (!alloc = !promote + !collect);
+ let iters = float_of_int iters and size_words = float_of_int size_words in
+ (* see comballoc.ml for notes on precision *)
+ Printf.printf "%.2f %.1f\n"
+ ((float_of_int !alloc /. iters) /. size_words)
+ ((float_of_int !promote /. iters) /. size_words *. 10.)
+
+
+let () =
+ [0.01; 0.5; 0.17] |> List.iter test
--- /dev/null
+0.01 0.0
+0.50 0.5
+0.17 0.2
its uncaught exception handler. *)
let _ = Printexc.record_backtrace false
+let () =
+ start ~callstack_size:10 ~sampling_rate:1.
+ (alloc_tracker (fun _ -> stop ()));
+ ignore (Sys.opaque_identity (Array.make 200 0))
+
let _ =
start ~callstack_size:10 ~sampling_rate:1.
(alloc_tracker (fun _ -> failwith "callback failed"));
(* TEST
flags = "-g"
- * bytecode
- * native
- compare_programs = "false"
*)
open Gc.Memprof
let alloc info =
(* We also allocate the list constructor in the minor heap,
so we filter that out. *)
- if info.unmarshalled then begin
+ if info.source = Marshal then begin
assert (info.size = 1 || info.size = 2);
assert (info.n_samples > 0);
smp := !smp + info.n_samples
(* TEST
flags = "-g"
- * bytecode
- * native
- compare_programs = "false"
*)
open Gc.Memprof
alloc_minor = (fun info ->
assert (info.size = 2);
assert (info.n_samples > 0);
- assert (not info.unmarshalled);
+ assert (info.source = Normal);
smp := !smp + info.n_samples;
None);
};
ignore (Sys.opaque_identity (alloc_stub ()));
assert(not !callback_done);
callback_ok := true;
- stop ();
- assert(!callback_done)
+ ignore (Sys.opaque_identity (ref ()));
+ assert(!callback_done);
+ stop ()
--- /dev/null
+(* TEST
+* hassysthreads
+include systhreads
+** bytecode
+** native
+*)
+
+let t2_begin = Atomic.make false
+let t2_promoting = Atomic.make false
+let t2_finish_promote = Atomic.make false
+let t2_done = Atomic.make false
+let t2_quit = Atomic.make false
+let await a =
+ while not (Atomic.get a) do Thread.yield () done
+let set a =
+ Atomic.set a true
+
+(* no-alloc printing to stdout *)
+let say msg =
+ Unix.write Unix.stdout (Bytes.unsafe_of_string msg) 0 (String.length msg) |> ignore
+
+let static_ref = ref 0
+let global = ref static_ref
+let thread_fn () =
+ await t2_begin;
+ say "T2: alloc\n";
+ let r = ref 0 in
+ global := r;
+ say "T2: minor GC\n";
+ Gc.minor ();
+ global := static_ref;
+ say "T2: done\n";
+ set t2_done;
+ await t2_quit
+
+let big = ref [| |]
+
+let fill_big () = big := Array.make 1000 42
+ [@@inline never] (* Prevent flambda to move the allocated array in a global
+ root (see #9978). *)
+let empty_big () = big := [| |]
+ [@@inline never]
+
+let () =
+ let th = Thread.create thread_fn () in
+ Gc.Memprof.(start ~sampling_rate:1.
+ { null_tracker with
+ alloc_minor = (fun _ ->
+ say " minor alloc\n";
+ Some ());
+ alloc_major = (fun _ ->
+ say " major alloc\n";
+ Some "major block\n");
+ promote = (fun () ->
+ say " promoting...\n";
+ set t2_promoting;
+ await t2_finish_promote;
+ say " ...done promoting\n";
+ Some "promoted block\n");
+ dealloc_major = (fun msg ->
+ say " major dealloc: "; say msg) });
+ say "T1: alloc\n";
+ fill_big ();
+ set t2_begin;
+ await t2_promoting;
+ say "T1: major GC\n";
+ empty_big ();
+ Gc.full_major ();
+ set t2_finish_promote;
+ await t2_done;
+ say "T1: major GC\n";
+ Gc.full_major ();
+ say "T1: done\n";
+ Gc.Memprof.stop ();
+ set t2_quit;
+ Thread.join th
--- /dev/null
+T1: alloc
+ major alloc
+T2: alloc
+ minor alloc
+T2: minor GC
+ promoting...
+T1: major GC
+ major dealloc: major block
+ ...done promoting
+T2: done
+T1: major GC
+ major dealloc: promoted block
+T1: done
(* TEST
-modules = "thread_exit_in_callback_stub.c"
-exit_status = "42"
* hassysthreads
include systhreads
** bytecode
** native
*)
-(* We cannot tell Ocamltest that this program is supposed to stop with
- a fatal error. Instead, we install a fatal error hook and call exit(42) *)
-external install_fatal_error_hook : unit -> unit = "install_fatal_error_hook"
+let _ =
+ let main_thread = Thread.id (Thread.self ()) in
+ Gc.Memprof.(start ~callstack_size:10 ~sampling_rate:1.
+ { null_tracker with alloc_minor = fun _ ->
+ if Thread.id (Thread.self ()) <> main_thread then
+ Thread.exit ();
+ None });
+ let t = Thread.create (fun () ->
+ ignore (Sys.opaque_identity (ref 1));
+ assert false) ()
+ in
+ Thread.join t;
+ Gc.Memprof.stop ()
let _ =
- install_fatal_error_hook ();
Gc.Memprof.(start ~callstack_size:10 ~sampling_rate:1.
{ null_tracker with alloc_minor = fun _ -> Thread.exit (); None });
- ignore (Sys.opaque_identity (ref 1))
+ ignore (Sys.opaque_identity (ref 1));
+ assert false
+++ /dev/null
-Fatal error hook: Thread.exit called from a memprof callback.
+++ /dev/null
-#include <stdio.h>
-#include "caml/misc.h"
-#include "caml/mlvalues.h"
-
-void fatal_error_hook_exit_3 (char *msg, va_list args) {
- fprintf(stderr, "Fatal error hook: ");
- vfprintf(stderr, msg, args);
- fprintf(stderr, "\n");
- exit(42);
-}
-
-
-value install_fatal_error_hook (value unit) {
- caml_fatal_error_hook = fatal_error_hook_exit_3;
- return Val_unit;
-}
\begin{camlexample}{verbatim}
\begin{caml}
\begin{camlinput}
-$\?$let start = 0
-$\?$$\ldots$
-$\?$let mid = succ hidden
-$\?$$\ldots$
+let start = 0
+$\ldots$
+let mid = succ hidden
+$\ldots$
-$\?$module E = struct end
-$\?$$\ldots$
+module E = struct end
+$\ldots$
-$\?$let expr = $\ldots$
+let expr = $\ldots$
-$\?$let pat = match start with
-$\?$ | $\ldots$ | 1 -> succ expr
-$\?$ | _ -> succ expr
+let pat = match start with
+ | $\ldots$ | 1 -> succ expr
+ | _ -> succ expr
-$\?$let case = match start with
-$\?$ | 0 -> succ pat
-$\?$ | $\ldots$
+let case = match start with
+ | 0 -> succ pat
+ | $\ldots$
-$\?$let annot: $\ldots$ = succ case
+let annot: $\ldots$ = succ case
-$\?$let subexpr = succ annot + ($\ldots$ * 2) - 2
+let subexpr = succ annot + ($\ldots$ * 2) - 2
-$\?$$\ldots$
+$\ldots$
-$\?$class c2 = object
-$\?$ $\ldots$
-$\?$ val y = 1
-$\?$ $\ldots$
-$\?$ method n = 3
-$\?$ $\ldots$
-$\?$end
+class c2 = object
+ $\ldots$
+ val y = 1
+ $\ldots$
+ method n = 3
+ $\ldots$
+end
-$\?$type t = $\ldots$ | B $\ldots$ | F
-$\?$type arrow = int -> ($\ldots$)
-$\?$type record = { a:int; $\ldots$ c:int;
-$\?$ $\ldots$
-$\?$ g:int }
-$\?$type polyvar = [`A|$\ldots$ |`C
-$\?$ |$\ldots$
-$\?$ | `G ]
-$\?$type exn += $\ldots$ | B $\ldots$ | F
+type t = $\ldots$ | B $\ldots$ | F
+type arrow = int -> ($\ldots$)
+type record = { a:int; $\ldots$ c:int;
+ $\ldots$
+ g:int }
+type polyvar = [`A|$\ldots$ |`C
+ |$\ldots$
+ | `G ]
+type exn += $\ldots$ | B $\ldots$ | F
\end{camlinput}
\end{caml}
\end{camlexample}
\begin{camlexample}{toplevel}
\begin{caml}
\begin{camlinput}
-$\?$[@@@warning "+A"];;
+$\?$ [@@@warning "+A"];;
\end{camlinput}
\end{caml}
\begin{caml}
\begin{camlinput}
-$\?$1 + <<2.>> ;;
+$\?$ 1 + <<2.>> ;;
\end{camlinput}
\begin{camlerror}
-$\:$Error: This expression has type float but an expression was expected of type
-$\:$ int
+Error: This expression has type float but an expression was expected of type
+ int
\end{camlerror}
\end{caml}
\begin{caml}
\begin{camlinput}
-$\?$let f <<x>> = () ;;
+$\?$ let f <<x>> = () ;;
\end{camlinput}
\begin{camlwarn}
-$\:$Warning 27: unused variable x.
-$\:$val f : 'a -> unit = <fun>
+Warning 27 [unused-var-strict]: unused variable x.
+val f : 'a -> unit = <fun>
\end{camlwarn}
\end{caml}
\end{camlexample}
\begin{camlexample}{toplevel}
\begin{caml}
\begin{camlinput}
-$\?$Format.printf "Hello@.";
-$\?$print_endline "world";;
+$\?$ Format.printf "Hello@.";
+ print_endline "world";;
\end{camlinput}
\begin{camloutput}
-$\:$Hello
-$\:$world
-$\:$- : unit = ()
+Hello
+world
+- : unit = ()
\end{camloutput}
\end{caml}
\end{camlexample}
File "tool-ocamlc-open-error.ml", line 1:
-Warning 24: bad source file name: "Tool-ocamlc-open-error" is not a valid module name.
+Warning 24 [bad-module-name]: bad source file name: "Tool-ocamlc-open-error" is not a valid module name.
File "command line argument: -open "F("", line 1, characters 1-2:
Error: Syntax error
[
- structure_item (stop_after_typing_impl.ml[13,349+0]..stop_after_typing_impl.ml[13,349+37])
+ structure_item (stop_after_typing_impl.ml[13,365+0]..stop_after_typing_impl.ml[13,365+37])
Tstr_primitive
- value_description apply/80 (stop_after_typing_impl.ml[13,349+0]..stop_after_typing_impl.ml[13,349+37])
- core_type (stop_after_typing_impl.ml[13,349+16]..stop_after_typing_impl.ml[13,349+26])
+ value_description apply (stop_after_typing_impl.ml[13,365+0]..stop_after_typing_impl.ml[13,365+37])
+ core_type (stop_after_typing_impl.ml[13,365+16]..stop_after_typing_impl.ml[13,365+26])
Ttyp_arrow
Nolabel
- core_type (stop_after_typing_impl.ml[13,349+16]..stop_after_typing_impl.ml[13,349+19])
- Ttyp_constr "int/1!"
+ core_type (stop_after_typing_impl.ml[13,365+16]..stop_after_typing_impl.ml[13,365+19])
+ Ttyp_constr "int!"
[]
- core_type (stop_after_typing_impl.ml[13,349+23]..stop_after_typing_impl.ml[13,349+26])
- Ttyp_constr "int/1!"
+ core_type (stop_after_typing_impl.ml[13,365+23]..stop_after_typing_impl.ml[13,365+26])
+ Ttyp_constr "int!"
[]
[
"%apply"
(* TEST
* setup-ocamlc.byte-build-env
** ocamlc.byte
- flags = "-stop-after typing -dtypedtree"
+ flags = "-stop-after typing -dno-unique-ids -dtypedtree"
ocamlc_byte_exit_status = "0"
*** check-ocamlc.byte-output
*)
+++ /dev/null
-#!/bin/sh
-
-if grep -q "#define HAS_LIBBFD" ${ocamlsrcdir}/runtime/caml/s.h; then
- exit ${TEST_PASS};
-fi
-echo libbfd not available > ${ocamltest_response}
-exit ${TEST_SKIP}
(* TEST
-script = "sh ${test_source_directory}/has-lib-bfd.sh"
* shared-libraries
-** script
-*** setup-ocamlopt.byte-build-env
-**** ocamlopt.byte
+** setup-ocamlopt.byte-build-env
+*** ocamlopt.byte
flags = "-shared"
all_modules = "question.ml"
program = "question.cmxs"
-***** check-ocamlopt.byte-output
-****** ocamlobjinfo
-******* check-program-output
+**** check-ocamlopt.byte-output
+***** ocamlobjinfo
+****** check-program-output
*)
let answer = 42
--- /dev/null
+File "check_for_pack.cmir-linear", line 1:
+Error: This input file cannot be compiled with -for-pack foo: it was generated without -for-pack.
--- /dev/null
+(* TEST
+ * native-compiler
+ ** setup-ocamlopt.byte-build-env
+ *** ocamlopt.byte
+ flags = "-save-ir-after scheduling"
+ ocamlopt_byte_exit_status = "0"
+ **** script
+ script = "touch empty.ml"
+ ***** ocamlopt.byte
+ flags = "-S check_for_pack.cmir-linear -for-pack foo"
+ module = "empty.ml"
+ ocamlopt_byte_exit_status = "2"
+ ****** check-ocamlopt.byte-output
+*)
+
+let foo f x =
+ if x > 0 then x * 7 else f x
+
+let bar x y = x + y
--- /dev/null
+(* TEST
+ * native-compiler
+ ** setup-ocamlopt.byte-build-env
+ *** ocamlopt.byte
+ flags = "-save-ir-after scheduling -S"
+ **** check-ocamlopt.byte-output
+ ***** script
+ script = "sh ${test_source_directory}/save_ir_after_scheduling.sh"
+*)
+
+let foo f x =
+ if x > 0 then x * 7 else f x
+
+let bar x y = x + y
--- /dev/null
+#!/bin/sh
+
+set -e
+
+cmir=save_ir_after_scheduling.cmir-linear
+
+# Check that cmir is generated
+if [ -e "$cmir" ] ; then
+ test_result=${TEST_PASS}
+else
+ echo "not found $cmir" > ${ocamltest_response}
+ test_result=${TEST_FAIL}
+fi
+exit ${test_result}
--- /dev/null
+wrong argument 'typing'; option '-save-ir-after' expects one of: scheduling.
--- /dev/null
+(* TEST
+ * native-compiler
+ ** setup-ocamlopt.byte-build-env
+ compiler_output = "compiler-output.raw"
+ *** ocamlopt.byte
+ flags = "-save-ir-after typing"
+ ocamlopt_byte_exit_status = "2"
+ *** script
+ script = "sh ${test_source_directory}/save_ir_after_typing.sh"
+ output = "compiler-output"
+ **** check-ocamlopt.byte-output
+ compiler_output = "compiler-output"
+*)
+
+(* this file is just a test driver, the test does not contain real OCaml code *)
--- /dev/null
+#!/bin/sh
+
+grep "wrong argument 'typing'" compiler-output.raw | grep "save-ir-after" | sed 's/^.*: wrong argument/wrong argument/'
--- /dev/null
+(* TEST
+ * native-compiler
+ ** setup-ocamlopt.byte-build-env
+ *** ocamlopt.byte
+ flags = "-save-ir-after scheduling -stop-after scheduling"
+ ocamlopt_byte_exit_status = "0"
+ **** script
+ script = "touch empty.ml"
+ ***** ocamlopt.byte
+ flags = "-S start_from_emit.cmir-linear"
+ module = "empty.ml"
+ ocamlopt_byte_exit_status = "0"
+ ****** check-ocamlopt.byte-output
+ ******* script
+ script = "sh ${test_source_directory}/start_from_emit.sh"
+ ******** ocamlopt.byte
+ flags = "-S start_from_emit.cmir-linear -save-ir-after scheduling"
+ module = "empty.ml"
+ ocamlopt_byte_exit_status = "0"
+ ********* script
+ script = "cp start_from_emit.cmir-linear expected.cmir_linear"
+ ********** check-ocamlopt.byte-output
+ *********** script
+ script = "cmp start_from_emit.cmir-linear expected.cmir_linear"
+
+*)
+
+let foo f x =
+ if x > 0 then x * 7 else f x
+
+let bar x y = x + y
--- /dev/null
+#!/bin/sh
+
+set -e
+
+obj=start_from_emit.${objext}
+
+# Check that obj is generated
+if [ -e "$obj" ] ; then
+ test_result=${TEST_PASS}
+else
+ echo "not found $obj" > ${ocamltest_response}
+ test_result=${TEST_FAIL}
+fi
+exit ${test_result}
--- /dev/null
+(* TEST
+ *)
+let () = set_binary_mode_out stdout true in
+(* ocamltest must normalise the \r\n *)
+print_string "line1\r\n"; flush stdout
--- /dev/null
+(* TEST
+ *)
+let () = set_binary_mode_out stdout true in
+(* ocamltest must normalise the \r\n *)
+print_string "line1\r\nline2\r\n"; flush stdout
--- /dev/null
+line1\r
+line2\r
--- /dev/null
+(* TEST
+ *)
+let () = set_binary_mode_out stdout true in
+(* ocamltest must normalise the \r\n but preserve the final \r *)
+print_string "line1\r\nline2\r"; flush stdout
--- /dev/null
+line1
+line2\r
\ No newline at end of file
--- /dev/null
+(* TEST
+ *)
+let () = set_binary_mode_out stdout true in
+(* ocamltest must normalise the \r\n *)
+print_string "line1\r\nline2"; flush stdout
--- /dev/null
+line1\r
+line2
\ No newline at end of file
Line 1, characters 11-15:
1 | let g () = f (); 1;;
^^^^
-Warning 21: this statement never returns (or has an unsound type.)
+Warning 21 [nonreturning-statement]: this statement never returns (or has an unsound type.)
val g : unit -> int = <fun>
Exception: Not_found.
Raised at f in file "//toplevel//", line 2, characters 11-26
Called from g in file "//toplevel//", line 1, characters 11-15
-Called from Toploop.load_lambda in file "toplevel/toploop.ml", line 212, characters 17-27
+Called from Stdlib__fun.protect in file "fun.ml", line 33, characters 8-15
+Re-raised at Stdlib__fun.protect in file "fun.ml", line 38, characters 6-52
+Called from Toploop.load_lambda in file "toplevel/toploop.ml", line 212, characters 4-150
Line 1, characters 18-54:
1 | let print_t out = function A -> Format.fprintf out "A";;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
B
val print_t : Format.formatter -> t -> unit = <fun>
--- /dev/null
+(* TEST
+ * expect
+*)
+
+(* Test a success case *)
+type 'a t = T of 'a
+;;
+T 123
+[%%expect {|
+type 'a t = T of 'a
+- : int t = T 123
+|}]
+
+(* no <poly> after fix *)
+type _ t = ..
+type 'a t += T of 'a
+;;
+T 123
+[%%expect {|
+type _ t = ..
+type 'a t += T of 'a
+- : int t = T 123
+|}]
+
+
+(* GADT with fixed arg type *)
+type _ t += T: char -> int t
+;;
+T 'x'
+[%%expect {|
+type _ t += T : char -> int t
+- : int t = T 'x'
+|}]
+
+
+(* GADT with poly arg type.... and the expected T <poly> *)
+type _ t += T: 'a -> int t
+;;
+T 'x'
+[%%expect {|
+type _ t += T : 'a -> int t
+- : int t = T <poly>
+|}]
+
+(* the rest are expected without <poly> *)
+type _ t += T: 'a * bool -> 'a t
+;;
+T ('x',true)
+[%%expect {|
+type _ t += T : 'a * bool -> 'a t
+- : char t = T ('x', true)
+|}]
+
+type _ t += T: 'a -> ('a * bool) t
+;;
+T 'x'
+[%%expect {|
+type _ t += T : 'a -> ('a * bool) t
+- : (char * bool) t = T 'x'
+|}]
eta_int32_ge = (function prim prim stub (Int32.>= prim prim))
eta_int64_ge = (function prim prim stub (Int64.>= prim prim))
eta_nativeint_ge = (function prim prim stub (Nativeint.>= prim prim))
- int_vec = [0: [0: 1 1] [0: [0: 1 2] [0: [0: 2 1] 0a]]]
- bool_vec = [0: [0: 0a 0a] [0: [0: 0a 1a] [0: [0: 1a 0a] 0a]]]
- intlike_vec = [0: [0: 0a 0a] [0: [0: 0a 1a] [0: [0: 1a 0a] 0a]]]
- float_vec = [0: [0: 1. 1.] [0: [0: 1. 2.] [0: [0: 2. 1.] 0a]]]
- string_vec = [0: [0: "1" "1"] [0: [0: "1" "2"] [0: [0: "2" "1"] 0a]]]
- int32_vec = [0: [0: 1l 1l] [0: [0: 1l 2l] [0: [0: 2l 1l] 0a]]]
- int64_vec = [0: [0: 1L 1L] [0: [0: 1L 2L] [0: [0: 2L 1L] 0a]]]
- nativeint_vec = [0: [0: 1n 1n] [0: [0: 1n 2n] [0: [0: 2n 1n] 0a]]]
+ int_vec = [0: [0: 1 1] [0: [0: 1 2] [0: [0: 2 1] 0]]]
+ bool_vec = [0: [0: 0 0] [0: [0: 0 1] [0: [0: 1 0] 0]]]
+ intlike_vec = [0: [0: 0 0] [0: [0: 0 1] [0: [0: 1 0] 0]]]
+ float_vec = [0: [0: 1. 1.] [0: [0: 1. 2.] [0: [0: 2. 1.] 0]]]
+ string_vec = [0: [0: "1" "1"] [0: [0: "1" "2"] [0: [0: "2" "1"] 0]]]
+ int32_vec = [0: [0: 1l 1l] [0: [0: 1l 2l] [0: [0: 2l 1l] 0]]]
+ int64_vec = [0: [0: 1L 1L] [0: [0: 1L 2L] [0: [0: 2L 1L] 0]]]
+ nativeint_vec = [0: [0: 1n 1n] [0: [0: 1n 2n] [0: [0: 2n 1n] 0]]]
test_vec =
(function cmp eq ne lt gt le ge vec
(let
(function f param (apply f (field 0 param) (field 1 param)))
map =
(function f l
- (apply (field 16 (global Stdlib__list!)) (apply uncurry f) l)))
+ (apply (field 18 (global Stdlib__list!)) (apply uncurry f) l)))
(makeblock 0
(makeblock 0 (apply map gen_cmp vec) (apply map cmp vec))
(apply map
(makeblock 0 (makeblock 0 gen_lt lt)
(makeblock 0 (makeblock 0 gen_gt gt)
(makeblock 0 (makeblock 0 gen_le le)
- (makeblock 0 (makeblock 0 gen_ge ge) 0a)))))))))))
+ (makeblock 0 (makeblock 0 gen_ge ge) 0)))))))))))
(seq
(apply test_vec int_cmp int_eq int_ne int_lt int_gt int_le int_ge
int_vec)
(apply f (field 0 param) (field 1 param)))
map =
(function f l
- (apply (field 16 (global Stdlib__list!))
+ (apply (field 18 (global Stdlib__list!))
(apply uncurry f) l)))
(makeblock 0
(makeblock 0 (apply map eta_gen_cmp vec)
(makeblock 0 (makeblock 0 eta_gen_lt lt)
(makeblock 0 (makeblock 0 eta_gen_gt gt)
(makeblock 0 (makeblock 0 eta_gen_le le)
- (makeblock 0 (makeblock 0 eta_gen_ge ge) 0a)))))))))))
+ (makeblock 0 (makeblock 0 eta_gen_ge ge) 0)))))))))))
(seq
(apply eta_test_vec eta_int_cmp eta_int_eq eta_int_ne eta_int_lt
eta_int_gt eta_int_le eta_int_ge int_vec)
let () = print_pos pos
let () = print_endline s3
+
+let id x = Sys.opaque_identity x
+
+let bang () = print_endline __FUNCTION__
+
+let fn_multi _ _ = print_endline __FUNCTION__
+
+let fn_function = function
+ | f -> print_endline __FUNCTION__
+
+let fn_poly : 'a . 'a -> unit = fun _ ->
+ print_endline __FUNCTION__
+
+module Mod1 = struct
+ module Nested = struct
+ let apply () = print_endline __FUNCTION__
+ end
+end
+
+let anon () =
+ print_endline __FUNCTION__;
+ let fn = print_endline __FUNCTION__; id (fun () -> print_endline __FUNCTION__) in
+ fn ()
+
+let double_anon f =
+ print_endline __FUNCTION__;
+ let fn = id (fun () ->
+ print_endline __FUNCTION__;
+ let fn = id (fun () -> print_endline __FUNCTION__) in
+ fn ()) in
+ fn ()
+
+let local () =
+ print_endline __FUNCTION__;
+ let inner () = print_endline __FUNCTION__ in
+ (id inner) ()
+
+let double_local () =
+ print_endline __FUNCTION__;
+ let inner1 () =
+ print_endline __FUNCTION__;
+ let inner2 () = print_endline __FUNCTION__ in
+ (id inner2) () in
+ (id inner1) ()
+
+let local_no_arg =
+ print_endline __FUNCTION__;
+ let inner () = print_endline __FUNCTION__ in
+ fun () -> print_endline __FUNCTION__; id inner ()
+
+let curried () =
+ print_endline __FUNCTION__;
+ let inner () () = print_endline __FUNCTION__ in
+ id (inner ())
+
+let local_module () =
+ print_endline __FUNCTION__;
+ let module N = struct
+ let foo () =
+ print_endline __FUNCTION__
+ let r = print_endline __FUNCTION__; ref ()
+ let () = r := id (id foo ())
+ end in
+ !N.r
+
+module Functor (X : sig end) = struct
+ let fn () = print_endline __FUNCTION__
+end
+module Inst = Functor (struct end)
+
+module rec Rec1 : sig
+ val fn : unit -> unit
+end = struct
+ module M = Rec2 (struct end)
+ let fn () = print_endline __FUNCTION__; M.fn ()
+end
+and Rec2 : functor (X : sig end) -> sig
+ val fn : unit -> unit
+end = functor (X : sig end) -> struct
+ let fn () = print_endline __FUNCTION__
+end
+
+let (+@+) _ _ = print_endline __FUNCTION__
+
+class klass = object (self)
+ method meth () =
+ print_endline __FUNCTION__
+end
+
+let inline_object () =
+ let obj = object (self)
+ method meth =
+ print_endline __FUNCTION__;
+ self#othermeth
+ method othermeth =
+ print_endline __FUNCTION__
+ end in
+ obj#meth
+
+let () =
+ fn_multi 1 1;
+ fn_function ();
+ fn_poly 42;
+ Mod1.Nested.apply ();
+ anon ();
+ double_anon ();
+ local ();
+ double_local ();
+ local_no_arg ();
+ curried () ();
+ local_module ();
+ Inst.fn ();
+ Rec1.fn ();
+ 42 +@+ 32;
+ (new klass)#meth ();
+ inline_object ();
+ bang ()
another expression
locs.ml, 40, 14, 49
yet another expression
+Locs.local_no_arg
+Locs.fn_multi
+Locs.fn_function
+Locs.fn_poly
+Locs.Mod1.Nested.apply
+Locs.anon
+Locs.anon
+Locs.anon.(fun)
+Locs.double_anon
+Locs.double_anon.(fun)
+Locs.double_anon.(fun)
+Locs.local
+Locs.local.inner
+Locs.double_local
+Locs.double_local.inner1
+Locs.double_local.inner1.inner2
+Locs.local_no_arg.(fun)
+Locs.local_no_arg.inner
+Locs.curried
+Locs.curried.inner
+Locs.local_module
+Locs.local_module.N.r
+Locs.local_module.N.foo
+Locs.Functor.fn
+Locs.Rec1.fn
+Locs.Rec2.fn
+Locs.(+@+)
+Locs.klass#meth
+Locs.inline_object.object#meth
+Locs.inline_object.object#othermeth
+Locs.bang
(setglobal Ref_spec!
(let
(int_ref = (makemutable 0 (int) 1)
- var_ref = (makemutable 0 65a)
- vargen_ref = (makemutable 0 65a)
- cst_ref = (makemutable 0 0a)
- gen_ref = (makemutable 0 0a)
+ var_ref = (makemutable 0 65)
+ vargen_ref = (makemutable 0 65)
+ cst_ref = (makemutable 0 0)
+ gen_ref = (makemutable 0 0)
flt_ref = (makemutable 0 (float) 0.))
- (seq (setfield_imm 0 int_ref 2) (setfield_imm 0 var_ref 66a)
- (setfield_ptr 0 vargen_ref [0: 66 0]) (setfield_ptr 0 vargen_ref 67a)
- (setfield_imm 0 cst_ref 1a) (setfield_ptr 0 gen_ref [0: "foo"])
- (setfield_ptr 0 gen_ref 0a) (setfield_ptr 0 flt_ref 1.)
+ (seq (setfield_imm 0 int_ref 2) (setfield_imm 0 var_ref 66)
+ (setfield_ptr 0 vargen_ref [0: 66 0]) (setfield_ptr 0 vargen_ref 67)
+ (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) 0a 1)
- var_rec = (makemutable 0 0a 65a)
- vargen_rec = (makemutable 0 0a 65a)
- cst_rec = (makemutable 0 0a 0a)
- gen_rec = (makemutable 0 0a 0a)
- flt_rec = (makemutable 0 (*,float) 0a 0.)
+ (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.)
flt_rec' = (makearray[float] 0. 0.))
- (seq (setfield_imm 1 int_rec 2) (setfield_imm 1 var_rec 66a)
+ (seq (setfield_imm 1 int_rec 2) (setfield_imm 1 var_rec 66)
(setfield_ptr 1 vargen_rec [0: 66 0])
- (setfield_ptr 1 vargen_rec 67a) (setfield_imm 1 cst_rec 1a)
- (setfield_ptr 1 gen_rec [0: "foo"]) (setfield_ptr 1 gen_rec 0a)
+ (setfield_ptr 1 vargen_rec 67) (setfield_imm 1 cst_rec 1)
+ (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))
Error: This pattern matches values of type int
but a pattern was expected which matches values of type int32
Hint: Did you mean `0l'?
-|}, Principal{|
-Line 2, characters 4-5:
-2 | | 0 -> 0l
- ^
-Error: This pattern matches values of type int
- but a pattern was expected which matches values of type int32
|}]
let _ : int64 -> int64 = function
bool
because it is in a when-guard
|}];;
+
+(* #10106 *)
+if false then (match () with () -> true);;
+[%%expect{|
+Line 1, characters 35-39:
+1 | if false then (match () with () -> true);;
+ ^^^^
+Error: This variant expression is expected to have type unit
+ because it is in the result of a conditional with no else branch
+ The constructor true does not belong to type unit
+|}]
Line 2, characters 13-25:
2 | val x: int [@@alert 42]
^^^^^^^^^^^^
-Warning 47: illegal payload for attribute 'alert'.
+Warning 47 [attribute-payload]: illegal payload for attribute 'alert'.
Invalid payload
Line 3, characters 13-29:
3 | val y: int [@@alert bla 42]
^^^^^^^^^^^^^^^^
-Warning 47: illegal payload for attribute 'alert'.
+Warning 47 [attribute-payload]: illegal payload for attribute 'alert'.
Invalid payload
Line 4, characters 13-28:
4 | val z: int [@@alert "bla"]
^^^^^^^^^^^^^^^
-Warning 47: illegal payload for attribute 'alert'.
+Warning 47 [attribute-payload]: illegal payload for attribute 'alert'.
Ill-formed list of alert settings
module X : sig val x : int val y : int val z : int end
|}]
Line 1, characters 20-33:
1 | [@@@ocaml.ppwarning "Pp warning!"]
^^^^^^^^^^^^^
-Warning 22: Pp warning!
+Warning 22 [preprocessor]: Pp warning!
|}]
Line 2, characters 24-39:
2 | [@@ocaml.ppwarning "Pp warning 2!"]
^^^^^^^^^^^^^^^
-Warning 22: Pp warning 2!
+Warning 22 [preprocessor]: Pp warning 2!
Line 1, characters 29-44:
1 | let x = () [@ocaml.ppwarning "Pp warning 1!"]
^^^^^^^^^^^^^^^
-Warning 22: Pp warning 1!
+Warning 22 [preprocessor]: Pp warning 1!
val x : unit = ()
|}]
Line 2, characters 22-35:
2 | [@ocaml.ppwarning "Pp warning!"]
^^^^^^^^^^^^^
-Warning 22: Pp warning!
+Warning 22 [preprocessor]: Pp warning!
type t = unit
|}]
Line 8, characters 22-36:
8 | [@@@ocaml.ppwarning "Pp warning2!"]
^^^^^^^^^^^^^^
-Warning 22: Pp warning2!
+Warning 22 [preprocessor]: Pp warning2!
module X : sig end
|}]
Line 3, characters 23-38:
3 | [@ocaml.ppwarning "Pp warning 2!"]
^^^^^^^^^^^^^^^
-Warning 22: Pp warning 2!
+Warning 22 [preprocessor]: Pp warning 2!
val x : unit = ()
|}]
Line 4, characters 21-36:
4 | [@@ocaml.ppwarning "Pp warning 3!"]
^^^^^^^^^^^^^^^
-Warning 22: Pp warning 3!
+Warning 22 [preprocessor]: Pp warning 3!
Line 3, characters 21-36:
3 | [@ocaml.ppwarning "Pp warning 2!"]
^^^^^^^^^^^^^^^
-Warning 22: Pp warning 2!
+Warning 22 [preprocessor]: Pp warning 2!
type t = unit
|}]
Line 1, characters 25-29:
1 | let ([][@ocaml.ppwarning "XX"]) = []
^^^^
-Warning 22: XX
+Warning 22 [preprocessor]: XX
Line 1, characters 4-31:
1 | let ([][@ocaml.ppwarning "XX"]) = []
^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
_::_
|}]
Line 7, characters 8-14:
7 | let x = Unique;;
^^^^^^
-Warning 41: Unique belongs to several types: b M.s t a
+Warning 41 [ambiguous-name]: Unique belongs to several types: b M.s t a
The first one was selected. Please disambiguate if this is wrong.
val x : b = Unique
|}]
let _ = X {x = 1};;
[%%expect {|
-- : int inline = X {x = <poly>}
+- : int inline = X {x = 1}
|}]
let must_be_polymorphic = fun x -> X {x};;
Line 3, characters 8-26:
3 | let f = function Foo -> ()
^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
*extension*
Matching over values of extensible variant types (the *extension* above)
2 | | [Foo] -> 1
3 | | _::_::_ -> 3
4 | | [] -> 2
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
*extension*::[]
Matching over values of extensible variant types (the *extension* above)
Line 1, characters 8-62:
1 | let f = function IPair (i, j) -> Format.sprintf "(%d, %d)" i j ;;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
*extension*
Matching over values of extensible variant types (the *extension* above)
--- /dev/null
+(* TEST
+ * expect
+*)
+
+module M = struct end
+
+module type S = sig
+ module Alias = M
+
+ type t
+end
+
+module type T = S with type t = int
+
+let h x = (x : (module S with type t = int) :> (module T))
+;;
+[%%expect {|
+module M : sig end
+module type S = sig module Alias = M type t end
+module type T = sig module Alias = M type t = int end
+val h : (module S with type t = int) -> (module T) = <fun>
+|}]
--- /dev/null
+(* TEST
+ * expect *)
+
+module type Vector_space = sig
+ type t
+ type scalar
+ val scale : scalar -> t -> t
+end;;
+[%%expect{|
+module type Vector_space =
+ sig type t type scalar val scale : scalar -> t -> t end
+|}];;
+
+module type Scalar = sig
+ type t
+ include Vector_space with type t := t
+ and type scalar = t
+end;;
+[%%expect{|
+module type Scalar =
+ sig type t type scalar = t val scale : scalar -> t -> t end
+|}];;
+
+module type Linear_map = sig
+ type ('a, 'b) t
+ val scale :
+ (module Vector_space with type t = 'a and type scalar = 'l) ->
+ 'l -> ('a, 'a) t
+end;;
+[%%expect{|
+module type Linear_map =
+ sig
+ type ('a, 'b) t
+ val scale :
+ (module Vector_space with type scalar = 'l and type t = 'a) ->
+ 'l -> ('a, 'a) t
+ end
+|}];;
+
+module Primitive(Linear_map : Linear_map) = struct
+ let f (type s) (s : (module Scalar with type t = s)) x =
+ Linear_map.scale s x
+end;;
+[%%expect{|
+Line 3, characters 21-22:
+3 | Linear_map.scale s x
+ ^
+Error: This expression has type (module Scalar with type t = s)
+ but an expression was expected of type
+ (module Vector_space with type scalar = 'a and type t = 'b)
+|}];;
Lines 6-7, characters 2-13:
6 | ..match tag with
7 | | Bool -> x
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
Int
val fbool : 't -> 't ty -> 't = <fun>
Lines 2-3, characters 2-16:
2 | ..match tag with
3 | | Int -> x > 0
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
Bool
val fint : 't -> 't ty -> bool = <fun>
Error: This pattern matches values of type bool t
but a pattern was expected which matches values of type int t
Type bool is not compatible with type int
-|}, Principal{|
-Line 4, characters 4-17:
-4 | | BoolLit, true -> ()
- ^^^^^^^^^^^^^
-Error: This pattern matches values of type bool t * bool
- but a pattern was expected which matches values of type int t * int
- Type bool is not compatible with type int
|}]
let simple_annotated (type a) (t : a t) (a : a) =
;;
[%%expect{|
-Lines 3-4, characters 4-30:
-3 | ....IntLit, ((3 : a) as x)
-4 | | BoolLit, ((true : a) as x)............
-Error: The variable x on the left-hand side of this or-pattern has type
- a but on the right-hand side it has type bool
+val simple_merged_annotated_return_annotated : 'a t -> 'a -> unit = <fun>
|}]
(* test more scenarios: when the or-pattern itself is not at toplevel but under
Error: This pattern matches values of type bool t
but a pattern was expected which matches values of type int t
Type bool is not compatible with type int
-|}, Principal{|
-Line 4, characters 4-14:
-4 | | BoolLit, x -> x
- ^^^^^^^^^^
-Error: This pattern matches values of type bool t * 'a
- but a pattern was expected which matches values of type int t * 'b
- Type bool is not compatible with type int
|}]
let noop_annotated (type a) (t : a t) (a : a) : a =
;;
[%%expect{|
-Line 3, characters 8-22:
-3 | | Int ((_ : a) as x)
- ^^^^^^^^^^^^^^
-Error: This pattern matches values of type a
- This instance of a is ambiguous:
- it would escape the scope of its equation
+val lambiguity : 'a t2 -> 'a = <fun>
|}]
let rambiguity (type a) (t2 : a t2) =
;;
[%%expect{|
-Line 4, characters 9-23:
-4 | | Bool ((_ : a) as x) -> x
- ^^^^^^^^^^^^^^
-Error: This pattern matches values of type a
- This instance of a is ambiguous:
- it would escape the scope of its equation
+Lines 3-4, characters 4-23:
+3 | ....Int (_ as x)
+4 | | Bool ((_ : a) as x).....
+Error: The variable x on the left-hand side of this or-pattern has type
+ int but on the right-hand side it has type a
|}]
7 | ...........................................function
8 | | One, One -> "two"
9 | | Two, Two -> "four"
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
-(Two, One)
+(One, Two)
module Add :
functor (T : sig type two end) ->
sig
14 | | Leq, Int x, Int y -> Bool (x <= y)
15 | | Leq, Bool x, Bool y -> Bool (x <= y)
16 | | Add, Int x, Int y -> Int (x + y)
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(Eq, Int _, _)
val eval : ('a, 'b, 'c) binop -> 'a constant -> 'b constant -> 'c constant =
Lines 7-8, characters 47-21:
7 | ...............................................match l, r with
8 | | A, B -> "f A B"
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(A, A)
module F :
Lines 10-11, characters 15-21:
10 | ...............match l, r with
11 | | A, B -> "f A B"
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(A, A)
module F :
(* It is not OK to allow modules exported by other compilation units *)
type (_,_) eq = Eq : ('a,'a) eq;;
let eq = Obj.magic Eq;;
-(* pretend that Queue.t is not injective *)
-let eq : ('a Queue.t, 'b Queue.t) eq = eq;;
-type _ t = T : 'a -> 'a Queue.t t;; (* fail *)
+let eq : (('a, 'b) Ephemeron.K1.t, ('c, 'd) Ephemeron.K1.t) eq = eq;;
+type _ t = T : 'a -> ('a, 'b) Ephemeron.K1.t t;; (* fail *)
[%%expect{|
type (_, _) eq = Eq : ('a, 'a) eq
val eq : 'a = <poly>
-val eq : ('a Queue.t, 'b Queue.t) eq = Eq
-Line 5, characters 0-33:
-5 | type _ t = T : 'a -> 'a Queue.t t;; (* fail *)
- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+val eq : (('a, 'b) Ephemeron.K1.t, ('c, 'd) Ephemeron.K1.t) eq = Eq
+Line 4, characters 0-46:
+4 | type _ t = T : 'a -> ('a, 'b) Ephemeron.K1.t t;; (* fail *)
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: In this definition, a type variable cannot be deduced
from the type parameters.
|}];;
Lines 16-17, characters 39-16:
16 | .......................................function
17 | | Any -> "Any"
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
Eq
val f : (M.s, [ `A | `B ]) t -> string = <fun>
Lines 12-13, characters 49-16:
12 | .................................................function
13 | | Any -> "Any"
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
Eq
val f : (N.s, < a : int; b : bool >) t -> string = <fun>
Line 16, characters 0-33:
16 | match M.comp with | Diff -> false;;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
Eq
Exception: Match_failure ("", 16, 0).
Line 11, characters 0-33:
11 | match M.comp with | Diff -> false;;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
Eq
Exception: Match_failure ("", 11, 0).
3 | fun C k -> k (fun x -> x);;
^
Error: This expression has type $0 but an expression was expected of type
- $1 = ($2 -> $1) -> $1
+ $1 = o
|}];;
Lines 8-9, characters 52-13:
8 | ....................................................function
9 | | B s -> s
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
A
module M :
but a pattern was expected which matches values of type
($0, $0 * insert, visit_action) context
The type constructor $0 would escape its scope
-|}, Principal{|
-type 'a visit_action
-type insert
-type 'a local_visit_action
-type ('a, 'result, 'visit_action) context =
- Local : ('a, 'a * insert, 'a local_visit_action) context
- | Global : ('a, 'a, 'a visit_action) context
-Line 15, characters 4-9:
-15 | | Local -> fun _ -> raise Exit
- ^^^^^
-Error: This pattern matches values of type
- ($0, $0 * insert, visit_action) context
- The type constructor $0 would escape its scope
|}];;
let vexpr (type visit_action)
but a pattern was expected which matches values of type
($'a, $'a * insert, visit_action) context
The type constructor $'a would escape its scope
-|}, Principal{|
-Line 4, characters 4-9:
-4 | | Local -> fun _ -> raise Exit
- ^^^^^
-Error: This pattern matches values of type
- ($0, $0 * insert, visit_action) context
- The type constructor $0 would escape its scope
|}];;
let vexpr (type result) (type visit_action)
Line 2, characters 36-66:
2 | let f : ('a list, 'a) eqp -> unit = function N s -> print_string s;;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
Y
val f : ('a list, 'a) eqp -> unit = <fun>
Line 5, characters 9-43:
5 | let get1 (Cons (x, _) : (_ * 'a, 'a) t) = x ;; (* warn, cf PR#6993 *)
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
Nil
val get1 : ('b * 'a, 'a) t -> 'b = <fun>
| (Cons (x, _) : (_ * 'a, 'a) t) -> x
| Nil -> assert false ;; (* ok *)
[%%expect{|
-val get1' : ('b * 'a as 'a, 'a) t -> 'b = <fun>
-|}, Principal{|
Line 3, characters 4-7:
3 | | Nil -> assert false ;; (* ok *)
^^^
but a pattern was expected which matches values of type
($Cons_'x, 'a -> $'b -> nil) elt
The type constructor $'b would escape its scope
-|}, Principal{|
-type +'a n = private int
-type nil = private Nil_type
-type (_, _) elt =
- Elt_fine : 'nat n -> ('l, 'nat * 'l) elt
- | Elt : 'nat n -> ('l, 'nat -> 'l) elt
-type _ t = Nil : nil t | Cons : ('x, 'fx) elt * 'x t -> 'fx t
-Line 9, characters 6-22:
-9 | let Cons(Elt dim, _) = sh in ()
- ^^^^^^^^^^^^^^^^
-Error: This pattern matches values of type ('a -> $0 -> nil) t
- The type constructor $0 would escape its scope
|}];;
Line 3, characters 15-40:
3 | let f (type a) (Neq n : (a, a t) eq) = n;; (* warn! *)
^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
Eq
val f : ('a, 'a t) eq -> int = <fun>
Line 2, characters 16-43:
2 | let f (type a) (Neq n : (a, a T.t) eq) = n (* warn! *)
^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
Eq
module F :
Line 4, characters 6-47:
4 | let f (T (`Other msg) : s t) = print_string msg;;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
T (`Conj _)
val f : s t -> unit = <fun>
Line 11, characters 12-59:
11 | let () = M.(match x with T (`Other msg) -> print_string msg);; (* warn *)
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
T (`Conj _)
Exception: Match_failure ("", 11, 12).
Line 13, characters 21-57:
13 | let () = M.(e { ex = fun (`Other msg) -> print_string msg });; (* warn *)
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
`Conj _
Exception: Match_failure ("", 13, 21).
Type a is not compatible with type t = [ `Rec of 'a ] X.t as 'a
|}]
-(* trigger segfault
+(* Trigger the unsoundness if Fix were definable *)
module Id = struct
type 'a t = 'b constraint 'a = [ `Rec of 'b ]
end
-
module Bad = Fix(Id)
-
-let segfault () =
- print_endline (cast (trans (Bad.uniq Refl) (Bad.uniq Refl)) 0)
-*)
+let magic : type a b. a -> b =
+ fun x ->
+ let Refl = (Bad.uniq Refl : (a,Bad.t) eq) in
+ let Refl = (Bad.uniq Refl : (b,Bad.t) eq) in x
+[%%expect{|
+module Id : sig type 'a t = 'b constraint 'a = [ `Rec of 'b ] end
+Line 4, characters 13-16:
+4 | module Bad = Fix(Id)
+ ^^^
+Error: Unbound module Fix
+|}]
(* addendum: ensure that hidden paths are checked too *)
module F (X : sig type 'a t end) = struct
Line 2, characters 2-28:
2 | fun (Either (Y a, N)) -> a;;
^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
Either (N, Y _)
val f : filled either -> string = <fun>
Line 2, characters 2-30:
2 | function `R {silly} -> silly
^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
`L Refl
val f : [ `L of (s, t) eql | `R of silly ] -> 'a = <fun>
--- /dev/null
+(* TEST
+ * expect
+*)
+
+type ('a, 'b) segment =
+ | SegNil : ('a, 'a) segment
+ | SegCons : ('a * 'a, 'b) segment -> ('a, 'b) segment
+
+let color : type a b . (a, b) segment -> int = function
+ | SegNil -> 0
+ | SegCons SegNil -> 0
+ | SegCons _ -> 0
+[%%expect{|
+type ('a, 'b) segment =
+ SegNil : ('a, 'a) segment
+ | SegCons : ('a * 'a, 'b) segment -> ('a, 'b) segment
+val color : ('a, 'b) segment -> int = <fun>
+|}]
+
+(* Fail *)
+let color (* : type a b . (a, b) segment -> int *) = function
+ | SegNil -> 0
+ | SegCons SegNil -> 0
+ | SegCons _ -> 0
+[%%expect{|
+Line 3, characters 12-18:
+3 | | SegCons SegNil -> 0
+ ^^^^^^
+Error: This pattern matches values of type ('a * 'a, 'a * 'a) segment
+ but a pattern was expected which matches values of type
+ ('a * 'a, 'a) segment
+ The type variable 'a occurs inside 'a * 'a
+|}]
6 | | MAB, _, A -> 2
7 | | _, AB, B -> 3
8 | | _, MAB, B -> 4
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(AB, MAB, A)
val f : 'x M.t -> 'x M.t -> 'x -> int = <fun>
Line 7, characters 4-22:
7 | | _, AB, { a = _ } -> 3
^^^^^^^^^^^^^^^^^^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
val f : 'x M.t -> 'x M.t -> 'x -> int = <fun>
|}]
9 | ..match a, a_or_b, x with
10 | | Not_A, A_or_B, `B i -> print_int i
11 | | _, A_or_B, `A s -> print_string s
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(A, A_or_B, `B _)
val f : 'x a -> 'x a_or_b -> 'x -> unit = <fun>
9 | ..match b, x, y with
10 | | B, `B String_option, Some s -> print_string s
11 | | A, `A, _ -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(B, `B String_option, None)
val f : ('x, 'y ty) b -> 'x -> 'y -> unit = <fun>
Line 2, characters 18-44:
2 | let f (x : _ a) = match x with `A None -> ();;
^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
`A (Some _)
val f : 'a option a -> unit = <fun>
Line 1, characters 23-47:
1 | let f (x : [> `A] a) = match x with `A `B -> ();;
^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
`A `A
val f : [< `A | `B > `A ] a -> unit = <fun>
--- /dev/null
+(* TEST
+ * expect
+*)
+
+(* #9759 by Thomas Refis *)
+
+type 'a general = { indir: 'a desc; unit: unit }
+and 'a desc =
+ | C : unit general -> unit desc ;;
+[%%expect{|
+type 'a general = { indir : 'a desc; unit : unit; }
+and 'a desc = C : unit general -> unit desc
+|}]
+
+let rec foo : type k . k general -> k general = fun g ->
+ match g.indir with
+ | C g' ->
+ let new_g' = foo g' in
+ if true then
+ {g with indir = C new_g'}
+ else
+ new_g'
+ | indir ->
+ {g with indir} ;;
+[%%expect{|
+Line 9, characters 4-9:
+9 | | indir ->
+ ^^^^^
+Warning 11 [redundant-case]: this match case is unused.
+val foo : 'k general -> 'k general = <fun>
+|}]
--- /dev/null
+(* TEST
+ * expect
+*)
+
+type 'a t =
+ | A: [`a|`z] t
+ | B: [`b|`z] t
+;;
+[%%expect{|
+type 'a t = A : [ `a | `z ] t | B : [ `b | `z ] t
+|}];;
+
+let fn: type a. a t -> a -> int = fun x y ->
+ match (x, y) with
+ | (A, `a)
+ | (B, `b) -> 0
+ | (A, `z)
+ | (B, `z) -> 1
+;;
+[%%expect{|
+val fn : 'a t -> 'a -> int = <fun>
+|}];;
--- /dev/null
+(* TEST
+ * expect *)
+
+module M = struct type t = A | B end;;
+[%%expect{|
+module M : sig type t = A | B end
+|}];;
+
+type 'a t = I : int t | M : M.t t;;
+[%%expect{|
+type 'a t = I : int t | M : M.t t
+|}];;
+
+type dyn = Sigma : 'a t * 'a -> dyn;;
+[%%expect{|
+type dyn = Sigma : 'a t * 'a -> dyn
+|}];;
+
+let f = function Sigma (M, A) -> ();;
+[%%expect{|
+Line 1, characters 8-35:
+1 | let f = function Sigma (M, A) -> ();;
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+Sigma (M, B)
+val f : dyn -> unit = <fun>
+|}];;
+
+type _ t = IntLit : int t | BoolLit : bool t;;
+[%%expect{|
+type _ t = IntLit : int t | BoolLit : bool t
+|}]
+
+(* The following should warn *)
+
+let f (type a) t (x : a) =
+ ignore (t : a t);
+ match t, x with
+ | IntLit, n -> n+1
+ | BoolLit, b -> 1
+;;
+[%%expect{|
+val f : 'a t -> 'a -> int = <fun>
+|}, Principal{|
+Line 4, characters 4-10:
+4 | | IntLit, n -> n+1
+ ^^^^^^
+Warning 18 [not-principal]: typing this pattern requires considering int and a as equal.
+But the knowledge of these types is not principal.
+Line 5, characters 4-11:
+5 | | BoolLit, b -> 1
+ ^^^^^^^
+Warning 18 [not-principal]: typing this pattern requires considering bool and a as equal.
+But the knowledge of these types is not principal.
+val f : 'a t -> 'a -> int = <fun>
+|}]
+
+let f (type a) t (x : a) =
+ ignore (t : a t);
+ match t, x with
+ | IntLit, n -> n+1
+ | _, _ -> 1
+;;
+[%%expect{|
+val f : 'a t -> 'a -> int = <fun>
+|}, Principal{|
+Line 4, characters 4-10:
+4 | | IntLit, n -> n+1
+ ^^^^^^
+Warning 18 [not-principal]: typing this pattern requires considering int and a as equal.
+But the knowledge of these types is not principal.
+val f : 'a t -> 'a -> int = <fun>
+|}]
+
+
+let f (type a) t (x : a) =
+ begin match t, x with
+ | IntLit, n -> n+1
+ | BoolLit, b -> 1
+ end;
+ ignore (t : a t)
+;;
+[%%expect{|
+Line 4, characters 4-11:
+4 | | BoolLit, b -> 1
+ ^^^^^^^
+Error: This pattern matches values of type bool t
+ but a pattern was expected which matches values of type int t
+ Type bool is not compatible with type int
+|}]
+
+let f (type a) t (x : a) =
+ begin match t, x with
+ | IntLit, n -> n+1
+ | _, _ -> 1
+ end;
+ ignore (t : a t)
+;;
+[%%expect{|
+Line 3, characters 17-18:
+3 | | IntLit, n -> n+1
+ ^
+Error: This expression has type a but an expression was expected of type int
+|}]
+
+(**********************)
+(* Derived from #9019 *)
+(**********************)
+
+type _ ab = A | B
+
+module M : sig
+ type _ mab
+ type _ t = AB : unit ab t | MAB : unit mab t
+end = struct
+ type 'a mab = 'a ab = A | B
+ type _ t = AB : unit ab t | MAB : unit mab t
+end;;
+[%%expect{|
+type _ ab = A | B
+module M : sig type _ mab type _ t = AB : unit ab t | MAB : unit mab t end
+|}]
+
+open M;;
+[%%expect{|
+|}]
+
+let f1 t1 =
+ match t1 with
+ | AB -> true
+ | MAB -> false;;
+[%%expect{|
+val f1 : unit ab M.t -> bool = <fun>
+|}, Principal{|
+Line 4, characters 4-7:
+4 | | MAB -> false;;
+ ^^^
+Warning 18 [not-principal]: typing this pattern requires considering unit M.mab and unit ab as equal.
+But the knowledge of these types is not principal.
+val f1 : unit ab M.t -> bool = <fun>
+|}]
+
+let f2 (type x) t1 =
+ ignore (t1 : x t);
+ match t1 with
+ | AB -> true
+ | MAB -> false;;
+[%%expect{|
+val f2 : 'x M.t -> bool = <fun>
+|}, Principal{|
+Line 4, characters 4-6:
+4 | | AB -> true
+ ^^
+Warning 18 [not-principal]: typing this pattern requires considering unit ab and x as equal.
+But the knowledge of these types is not principal.
+Line 5, characters 4-7:
+5 | | MAB -> false;;
+ ^^^
+Warning 18 [not-principal]: typing this pattern requires considering unit M.mab and x as equal.
+But the knowledge of these types is not principal.
+val f2 : 'x M.t -> bool = <fun>
+|}]
+
+(* This should warn *)
+let f3 t1 =
+ ignore (t1 : unit ab t);
+ match t1 with
+ | AB -> true
+ | MAB -> false;;
+[%%expect{|
+val f3 : unit ab M.t -> bool = <fun>
+|}, Principal{|
+Line 5, characters 4-7:
+5 | | MAB -> false;;
+ ^^^
+Warning 18 [not-principal]: typing this pattern requires considering unit M.mab and unit ab as equal.
+But the knowledge of these types is not principal.
+val f3 : unit ab M.t -> bool = <fun>
+|}]
+
+(* Example showing we need to warn when any part of the type is non generic. *)
+type (_,_) eq = Refl : ('a,'a) eq;;
+[%%expect{|
+type (_, _) eq = Refl : ('a, 'a) eq
+|}]
+
+let g1 (type x) (e : (x, int option) eq) (x : x) : int option =
+ let Refl = e in x;;
+[%%expect{|
+val g1 : ('x, int option) eq -> 'x -> int option = <fun>
+|}]
+
+(* This should warn *)
+let g2 (type x) (e : (x, _ option) eq) (x : x) : int option =
+ ignore (e : (x, int option) eq);
+ let Refl = e in x;;
+[%%expect{|
+val g2 : ('x, int option) eq -> 'x -> int option = <fun>
+|}, Principal{|
+Line 3, characters 7-11:
+3 | let Refl = e in x;;
+ ^^^^
+Warning 18 [not-principal]: typing this pattern requires considering x and int option as equal.
+But the knowledge of these types is not principal.
+val g2 : ('x, int option) eq -> 'x -> int option = <fun>
+|}]
+
+(* Issues with "principal level" *)
+
+module Foo : sig
+ type t
+end = struct
+ type t = int
+end
+
+type _ gadt = F : Foo.t gadt
+
+type 'a t = { a: 'a; b: 'a gadt } ;;
+[%%expect{|
+module Foo : sig type t end
+type _ gadt = F : Foo.t gadt
+type 'a t = { a : 'a; b : 'a gadt; }
+|}]
+
+let () =
+ match [] with
+ | [ { a = 3; _ } ; { b = F; _ }] -> ()
+ | _ -> ();;
+[%%expect{|
+|}, Principal{|
+Line 3, characters 27-28:
+3 | | [ { a = 3; _ } ; { b = F; _ }] -> ()
+ ^
+Warning 18 [not-principal]: typing this pattern requires considering Foo.t and int as equal.
+But the knowledge of these types is not principal.
+|}]
+
+let () =
+ match [] with
+ | [ { b = F; _ } ; { a = 3; _ }] -> ()
+ | _ -> ();;
+[%%expect{|
+Line 3, characters 27-28:
+3 | | [ { b = F; _ } ; { a = 3; _ }] -> ()
+ ^
+Error: This pattern matches values of type int
+ but a pattern was expected which matches values of type Foo.t
+|}]
+
+type (_, _, _) eq3 = Refl3 : ('a, 'a, 'a) eq3
+
+type 'a t = { a: 'a; b: (int, Foo.t, 'a) eq3 }
+;;
+[%%expect{|
+type (_, _, _) eq3 = Refl3 : ('a, 'a, 'a) eq3
+type 'a t = { a : 'a; b : (int, Foo.t, 'a) eq3; }
+|}]
+
+let () =
+ match [] with
+ | [ { a = 3; _ }; { b = Refl3 ; _ }] -> ()
+ | _ -> ()
+;;
+[%%expect{|
+|}, Principal{|
+Line 3, characters 26-31:
+3 | | [ { a = 3; _ }; { b = Refl3 ; _ }] -> ()
+ ^^^^^
+Warning 18 [not-principal]: typing this pattern requires considering int and Foo.t as equal.
+But the knowledge of these types is not principal.
+|}]
+
+let () =
+ match [] with
+ | [ { b = Refl3 ; _ }; { a = 3; _ } ] -> ()
+ | _ -> ()
+;;
+[%%expect{|
+|}, Principal{|
+Line 3, characters 12-17:
+3 | | [ { b = Refl3 ; _ }; { a = 3; _ } ] -> ()
+ ^^^^^
+Warning 18 [not-principal]: typing this pattern requires considering int and Foo.t as equal.
+But the knowledge of these types is not principal.
+|}]
+
+(* Unify with 'a first *)
+
+type 'a t = { a: 'a; b: ('a, int, Foo.t) eq3 }
+;;
+[%%expect{|
+type 'a t = { a : 'a; b : ('a, int, Foo.t) eq3; }
+|}]
+
+let () =
+ match [] with
+ | [ { a = 3; _ }; { b = Refl3 ; _ }] -> ()
+ | _ -> ()
+[%%expect{|
+|}, Principal{|
+Line 3, characters 26-31:
+3 | | [ { a = 3; _ }; { b = Refl3 ; _ }] -> ()
+ ^^^^^
+Warning 18 [not-principal]: typing this pattern requires considering int and Foo.t as equal.
+But the knowledge of these types is not principal.
+|}]
+
+let () =
+ match [] with
+ | [ { b = Refl3 ; _ }; { a = 3; _ } ] -> ()
+ | _ -> ()
+[%%expect{|
+|}, Principal{|
+Line 3, characters 12-17:
+3 | | [ { b = Refl3 ; _ }; { a = 3; _ } ] -> ()
+ ^^^^^
+Warning 18 [not-principal]: typing this pattern requires considering int and Foo.t as equal.
+But the knowledge of these types is not principal.
+|}]
+
+
+(*************)
+(* Some more *)
+(*************)
+
+module M : sig type t end = struct type t = int end
+module N : sig type t end = struct type t = int end
+;;
+[%%expect{|
+module M : sig type t end
+module N : sig type t end
+|}]
+
+type 'a foo = { x : 'a; eq : (M.t, N.t, 'a) eq3 };;
+[%%expect{|
+type 'a foo = { x : 'a; eq : (M.t, N.t, 'a) eq3; }
+|}]
+
+let foo x =
+ match x with
+ | { x = x; eq = Refl3 } -> x
+;;
+[%%expect{|
+val foo : M.t foo -> M.t = <fun>
+|}, Principal{|
+Line 3, characters 18-23:
+3 | | { x = x; eq = Refl3 } -> x
+ ^^^^^
+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 : M.t foo -> M.t = <fun>
+|}]
+
+let foo x =
+ match x with
+ | { x = (x : int); eq = Refl3 } -> x
+;;
+[%%expect{|
+val foo : int foo -> int = <fun>
+|}, Principal{|
+Line 3, characters 26-31:
+3 | | { x = (x : int); eq = Refl3 } -> x
+ ^^^^^
+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>
+|}]
+
+let foo x =
+ match x with
+ | { x = (x : N.t); eq = Refl3 } -> x
+;;
+[%%expect{|
+Line 3, characters 4-33:
+3 | | { x = (x : N.t); eq = Refl3 } -> x
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This pattern matches values of type N.t foo
+ but a pattern was expected which matches values of type 'a
+ This instance of M.t is ambiguous:
+ it would escape the scope of its equation
+|}, Principal{|
+Line 3, characters 26-31:
+3 | | { x = (x : N.t); eq = Refl3 } -> x
+ ^^^^^
+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.
+Line 3, characters 4-33:
+3 | | { x = (x : N.t); eq = Refl3 } -> x
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This pattern matches values of type N.t foo
+ but a pattern was expected which matches values of type 'a
+ This instance of M.t is ambiguous:
+ it would escape the scope of its equation
+|}]
+
+let foo x =
+ match x with
+ | { x = (x : string); eq = Refl3 } -> x
+;;
+[%%expect{|
+val foo : string foo -> string = <fun>
+|}, Principal{|
+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.
+But the knowledge of these types is not principal.
+val foo : string foo -> string = <fun>
+|}]
+
+let bar x =
+ match x with
+ | { x = x; _ } -> x
+;;
+[%%expect{|
+val bar : 'a foo -> 'a = <fun>
+|}]
+
+let bar x =
+ match x with
+ | { x = (x : int); _ } -> x
+;;
+[%%expect{|
+val bar : int foo -> int = <fun>
+|}]
+
+let bar x =
+ match x with
+ | { x = (x : N.t); _ } -> x
+;;
+[%%expect{|
+val bar : N.t foo -> N.t = <fun>
+|}]
+
+let bar x =
+ match x with
+ | { x = (x : string); _ } -> x
+;;
+[%%expect{|
+val bar : string foo -> string = <fun>
+|}]
Lines 11-12, characters 6-19:
11 | ......function
12 | | C2 x -> x
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
C1 _
Lines 24-26, characters 6-30:
24 | ......function
25 | | Foo _ , Foo _ -> true
26 | | Bar _, Bar _ -> true
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
-(Bar _, Foo _)
+(Foo _, Bar _)
module Nonexhaustive :
sig
type 'a u = C1 : int -> int u | C2 : bool -> bool u
Line 2, characters 10-18:
2 | class c (Some x) = object method x : int = x end
^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
None
Line 4, characters 10-18:
4 | class d (Just x) = object method x : int = x end
^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
Nothing
module PR6862 :
Line 4, characters 43-44:
4 | let g : int t -> int = function I -> 1 | _ -> 2 (* warn *)
^
-Warning 56: this match case is unreachable.
+Warning 56 [unreachable-case]: this match case is unreachable.
Consider replacing it with a refutation case '<pat> -> .'
module PR6220 :
sig
Lines 8-9, characters 4-33:
8 | ....match x with
9 | | String s -> print_endline s.................
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
Any
module PR6801 :
^
Error: This variant pattern is expected to have type a
The constructor B does not belong to type a
-|}, Principal{|
-Line 5, characters 28-29:
-5 | let f = function A -> 1 | B -> 2
- ^
-Error: This pattern matches values of type b
- but a pattern was expected which matches values of type a
|}];;
module PR6849 = struct
6 | | TE TC, D [|1.0|] -> 14
7 | | TA, D 0 -> -1
8 | | TA, D z -> z
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(TE TC, D [| 0. |])
val f : 'a ty -> 'a t -> int = <fun>
8 | | {left=TE TC; right=D [|1.0|]} -> 14
9 | | {left=TA; right=D 0} -> -1
10 | | {left=TA; right=D z} -> z
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
{left=TE TC; right=D [| 0. |]}
val f : 'a ty -> 'a t -> int = <fun>
5 | .......................................function
6 | | BoolLit, false -> false
7 | | IntLit , 6 -> false
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
-(IntLit, 0)
+(BoolLit, true)
val check : 's t * 's -> bool = <fun>
|}];;
3 | .............................................function
4 | | {fst = BoolLit; snd = false} -> false
5 | | {fst = IntLit ; snd = 6} -> false
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
-{fst=IntLit; snd=0}
+{fst=BoolLit; snd=true}
val check : ('s t, 's) pair -> bool = <fun>
|}];;
let f (module M : S with type t = 'a) = M.x;; (* Error *)
[%%expect{|
-Line 1, characters 6-37:
+Line 1, characters 14-15:
1 | let f (module M : S with type t = 'a) = M.x;; (* Error *)
- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+ ^
Error: The type of this packed module contains variables:
(module S with type t = 'a)
|}];;
module type MapT =
sig
type key
- type +'a t
+ type +!'a t
val empty : 'a t
val is_empty : 'a t -> bool
val mem : key -> 'a t -> bool
val map : ('a -> 'b) -> 'a t -> 'b t
val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
val to_seq : 'a t -> (key * 'a) Seq.t
+ val to_rev_seq : 'a t -> (key * 'a) Seq.t
val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
val of_seq : (key * 'a) Seq.t -> 'a t
val map : ('a -> 'b) -> 'a t -> 'b t
val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
val to_seq : 'a t -> (key * 'a) Seq.t
+ val to_rev_seq : 'a t -> (key * 'a) Seq.t
val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
val of_seq : (key * 'a) Seq.t -> 'a t
--- /dev/null
+(* TEST
+ * expect
+*)
+
+let f = function
+ | ([] : int list) as x -> x
+ | _ :: _ -> assert false;;
+[%%expect{|
+val f : int list -> int list = <fun>
+|}]
+
+let f =
+ let f' = function
+ | ([] : 'a list) as x -> x
+ | _ :: _ -> assert false
+ in
+ f', f';;
+[%%expect{|
+val f : ('a list -> 'a list) * ('a list -> 'a list) = (<fun>, <fun>)
+|}]
+
+let f =
+ let f' = function
+ | ([] : _ list) as x -> x
+ | _ :: _ -> assert false
+ in
+ f', f';;
+[%%expect{|
+val f : ('a list -> 'b list) * ('c list -> 'd list) = (<fun>, <fun>)
+|}]
+
+let f =
+ let f' (type a) = function
+ | ([] : a list) as x -> x
+ | _ :: _ -> assert false
+ in
+ f', f';;
+[%%expect{|
+val f : ('a list -> 'a list) * ('b list -> 'b list) = (<fun>, <fun>)
+|}]
+
+type t = [ `A | `B ];;
+[%%expect{|
+type t = [ `A | `B ]
+|}]
+
+let f = function `A as x -> x | `B -> `A;;
+[%%expect{|
+val f : [< `A | `B ] -> [> `A ] = <fun>
+|}]
+
+let f = function (`A : t) as x -> x | `B -> `A;;
+[%%expect{|
+val f : t -> t = <fun>
+|}]
+
+let f : t -> _ = function `A as x -> x | `B -> `A;;
+[%%expect{|
+val f : t -> [> `A ] = <fun>
+|}]
+
+let f = function
+ | (`A : t) as x ->
+ (* This should be flagged as non-exhaustive: because of the constraint [x]
+ is of type [t]. *)
+ begin match x with
+ | `A -> ()
+ end
+ | `B -> ();;
+[%%expect{|
+Lines 5-7, characters 4-7:
+5 | ....begin match x with
+6 | | `A -> ()
+7 | end
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+`B
+val f : t -> unit = <fun>
+|}]
+
+
+let f = function
+ | (`A : t) as x ->
+ begin match x with
+ | `A -> ()
+ | `B -> ()
+ end
+ | `B -> ();;
+[%%expect{|
+val f : t -> unit = <fun>
+|}]
+
+
+let f = function
+ | (`A : t) as x ->
+ begin match x with
+ | `A -> ()
+ | `B -> ()
+ | `C -> ()
+ end
+ | `B -> ();;
+[%%expect{|
+Line 6, characters 6-8:
+6 | | `C -> ()
+ ^^
+Error: This pattern matches values of type [? `C ]
+ but a pattern was expected which matches values of type t
+ The second variant type does not allow tag(s) `C
+|}]
+
+let f = function (`A, _ : _ * int) as x -> x;;
+[%%expect{|
+val f : [< `A ] * int -> [> `A ] * int = <fun>
+|}]
+
+(* Make sure *all* the constraints are respected: *)
+
+let f = function
+ | ((`A : _) : t) as x ->
+ (* This should be flagged as non-exhaustive: because of the constraint [x]
+ is of type [t]. *)
+ begin match x with
+ | `A -> ()
+ end
+ | `B -> ();;
+[%%expect{|
+Lines 5-7, characters 4-7:
+5 | ....begin match x with
+6 | | `A -> ()
+7 | end
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+`B
+val f : t -> unit = <fun>
+|}]
+
+let f = function
+ | ((`A : t) : _) as x ->
+ (* This should be flagged as non-exhaustive: because of the constraint [x]
+ is of type [t]. *)
+ begin match x with
+ | `A -> ()
+ end
+ | `B -> ();;
+
+[%%expect{|
+Lines 5-7, characters 4-7:
+5 | ....begin match x with
+6 | | `A -> ()
+7 | end
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+`B
+val f : t -> unit = <fun>
+|}]
'a is_an_object as 'a
|}];;
-module PR6505a = struct
+module PR6505a_old = struct
type 'o is_an_object = < .. > as 'o
and ('k,'l) abs = 'l constraint 'k = 'l is_an_object
let y : ('o, 'o) abs = object end
end;;
+[%%expect{|
+Line 3, characters 7-9:
+3 | and ('k,'l) abs = 'l constraint 'k = 'l is_an_object
+ ^^
+Error: Constraints are not satisfied in this type.
+ Type 'l is_an_object should be an instance of < .. > is_an_object
+|}]
+
+module PR6505a = struct
+ type 'o is_an_object = < .. > as 'o
+ type ('k,'l) abs = 'l constraint 'k = 'l is_an_object
+ let y : ('o, 'o) abs = object end
+end;;
let _ = PR6505a.y#bang;; (* fails *)
[%%expect{|
module PR6505a :
sig
type 'o is_an_object = 'o constraint 'o = < .. >
- and ('a, 'l) abs = 'l constraint 'a = 'l is_an_object
+ type ('a, 'b) abs = 'b constraint 'a = 'b is_an_object
+ constraint 'b = < .. >
val y : (< > is_an_object, < > is_an_object) abs
end
Line 6, characters 8-17:
module PR6505a :
sig
type 'o is_an_object = 'o constraint 'o = < .. >
- and ('a, 'l) abs = 'l constraint 'a = 'l is_an_object
+ type ('a, 'b) abs = 'b constraint 'a = 'b is_an_object
+ constraint 'b = < .. >
val y : (< >, < >) abs
end
Line 6, characters 8-17:
module PR6505b = struct
type 'o is_an_object = [> ] as 'o
- and ('k,'l) abs = 'l constraint 'k = 'l is_an_object
+ type ('k,'l) abs = 'l constraint 'k = 'l is_an_object
let x : ('a, 'a) abs = `Foo 6
end;;
let () = print_endline (match PR6505b.x with `Bar s -> s);; (* fails *)
module PR6505b :
sig
type 'o is_an_object = 'o constraint 'o = [> ]
- and ('a, 'l) abs = 'l constraint 'a = 'l is_an_object
+ type ('a, 'b) abs = 'b constraint 'a = 'b is_an_object
+ constraint 'b = [> ]
val x : (([> `Foo of int ] as 'a) is_an_object, 'a is_an_object) abs
end
Line 6, characters 23-57:
6 | let () = print_endline (match PR6505b.x with `Bar s -> s);; (* fails *)
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
`Foo _
Exception: Match_failure ("", 6, 23).
|}]
+
+
+(* #9866, #9873 *)
+
+type 'a t = 'b constraint 'a = 'b t;;
+[%%expect{|
+Line 1, characters 0-36:
+1 | type 'a t = 'b constraint 'a = 'b t;;
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This recursive type is not regular.
+ The type constructor t is defined as
+ type 'b t t
+ but it is used as
+ 'b t.
+ All uses need to match the definition for the recursive type to be regular.
+|}]
+
+type 'a t = 'b constraint 'a = ('b * 'b) t;;
+[%%expect{|
+Line 1, characters 0-42:
+1 | type 'a t = 'b constraint 'a = ('b * 'b) t;;
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This recursive type is not regular.
+ The type constructor t is defined as
+ type ('b * 'b) t t
+ but it is used as
+ ('b * 'b) t.
+ All uses need to match the definition for the recursive type to be regular.
+|}]
+
+type 'a t = 'a * 'b constraint _ * 'a = 'b t;;
+type 'a t = 'a * 'b constraint 'a = 'b t;;
+[%%expect{|
+type 'b t = 'b * 'b
+Line 2, characters 0-40:
+2 | type 'a t = 'a * 'b constraint 'a = 'b t;;
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The type abbreviation t is cyclic
+|}]
+
+type 'a t = <a : 'a; b : 'b> constraint 'a = 'b t;;
+[%%expect{|
+Line 1, characters 0-49:
+1 | type 'a t = <a : 'a; b : 'b> constraint 'a = 'b t;;
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This recursive type is not regular.
+ The type constructor t is defined as
+ type 'b t t
+ but it is used as
+ 'b t.
+ All uses need to match the definition for the recursive type to be regular.
+|}]
+
+type 'a t = <a : 'a; b : 'b> constraint <a : 'a; ..> = 'b t;;
+[%%expect{|
+Line 1, characters 0-59:
+1 | type 'a t = <a : 'a; b : 'b> constraint <a : 'a; ..> = 'b t;;
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: A type variable is unbound in this type declaration.
+In method b: 'b the variable 'b is unbound
+|}]
+
+module rec M : sig type 'a t = 'b constraint 'a = 'b t end = M;;
+[%%expect{|
+Line 1, characters 19-54:
+1 | module rec M : sig type 'a t = 'b constraint 'a = 'b t end = M;;
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This recursive type is not regular.
+ The type constructor t is defined as
+ type 'b t t
+ but it is used as
+ 'b t.
+ All uses need to match the definition for the recursive type to be regular.
+|}]
+module rec M : sig type 'a t = 'b constraint 'a = ('b * 'b) t end = M;;
+[%%expect{|
+Line 1, characters 19-61:
+1 | module rec M : sig type 'a t = 'b constraint 'a = ('b * 'b) t end = M;;
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This recursive type is not regular.
+ The type constructor t is defined as
+ type ('b * 'b) t t
+ but it is used as
+ ('b * 'b) t.
+ All uses need to match the definition for the recursive type to be regular.
+|}]
+
+module type S =
+sig
+ type !'a s
+ type !'a t = 'b constraint 'a = 'b s
+end
+[%%expect{|
+module type S = sig type !'a s type 'a t = 'b constraint 'a = 'b s end
+|}]
+
+(* This still causes a stack overflow *)
+(*
+module rec M : S =
+struct
+ type !'a s = 'a M.t
+ type !'a t = 'b constraint 'a = 'b s
+end
+*)
Line 3, characters 2-20:
3 | { x with lbl = 4 }
^^^^^^^^^^^^^^^^^^
-Warning 23: all the fields are explicitly listed in this record:
+Warning 23 [useless-record-with]: all the fields are explicitly listed in this record:
the 'with' clause is useless.
val after_a : M.r = {M.lbl = 4}
|}]
Line 3, characters 7-18:
3 | x := { lbl = 4 }
^^^^^^^^^^^
-Warning 18: this type-based record disambiguation is not principal.
+Warning 18 [not-principal]: this type-based record disambiguation is not principal.
val b : unit = ()
|}]
Line 4, characters 4-15:
4 | | { lbl = _ } -> ()
^^^^^^^^^^^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
val h : M.r -> unit = <fun>
|}, Principal{|
-Line 4, characters 6-9:
+Line 4, characters 4-15:
4 | | { lbl = _ } -> ()
- ^^^
-Error: Unbound record field lbl
+ ^^^^^^^^^^^
+Warning 18 [not-principal]: this type-based record disambiguation is not principal.
+Line 4, characters 4-15:
+4 | | { lbl = _ } -> ()
+ ^^^^^^^^^^^
+Warning 11 [redundant-case]: this match case is unused.
+val h : M.r -> unit = <fun>
|}]
let i x =
Line 4, characters 4-15:
4 | | { lbl = _ } -> ()
^^^^^^^^^^^
-Warning 12: this sub-pattern is unused.
+Warning 12 [redundant-subpat]: this sub-pattern is unused.
+val j : M.r -> unit = <fun>
+|}, Principal{|
+Line 4, characters 4-15:
+4 | | { lbl = _ } -> ()
+ ^^^^^^^^^^^
+Warning 18 [not-principal]: this type-based record disambiguation is not principal.
+Line 4, characters 4-15:
+4 | | { lbl = _ } -> ()
+ ^^^^^^^^^^^
+Warning 12 [redundant-subpat]: this sub-pattern is unused.
val j : M.r -> unit = <fun>
|}]
Line 4, characters 4-30:
4 | | { contents = { lbl = _ } } -> ()
^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
val n : M.r ref -> unit = <fun>
|}, Principal{|
-Line 4, characters 19-22:
+Line 4, characters 17-28:
4 | | { contents = { lbl = _ } } -> ()
- ^^^
-Error: Unbound record field lbl
+ ^^^^^^^^^^^
+Warning 18 [not-principal]: this type-based record disambiguation is not principal.
+Line 4, characters 4-30:
+4 | | { contents = { lbl = _ } } -> ()
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 11 [redundant-case]: this match case is unused.
+val n : M.r ref -> unit = <fun>
|}]
let o x =
Line 4, characters 4-30:
4 | | { contents = { lbl = _ } } -> ()
^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 12: this sub-pattern is unused.
+Warning 12 [redundant-subpat]: this sub-pattern is unused.
+val p : M.r ref -> unit = <fun>
+|}, Principal{|
+Line 4, characters 17-28:
+4 | | { contents = { lbl = _ } } -> ()
+ ^^^^^^^^^^^
+Warning 18 [not-principal]: this type-based record disambiguation is not principal.
+Line 4, characters 4-30:
+4 | | { contents = { lbl = _ } } -> ()
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 12 [redundant-subpat]: this sub-pattern is unused.
val p : M.r ref -> unit = <fun>
|}]
Line 4, characters 9-20:
4 | x := { lbl = 4 }
^^^^^^^^^^^
-Warning 18: this type-based record disambiguation is not principal.
+Warning 18 [not-principal]: this type-based record disambiguation is not principal.
val s : M.r ref -> unit = <fun>
|}]
Line 3, characters 9-20:
3 | x := { lbl = 4 }
^^^^^^^^^^^
-Warning 18: this type-based record disambiguation is not principal.
+Warning 18 [not-principal]: this type-based record disambiguation is not principal.
val t : M.r ref -> unit = <fun>
|}]
;;
[%%expect{|
val u : M.r ref -> int = <fun>
-|}, Principal{|
-Line 3, characters 7-10:
-3 | !x.lbl
- ^^^
-Warning 18: this type-based field disambiguation is not principal.
-val u : M.r ref -> int = <fun>
|}]
Line 3, characters 7-8:
3 | x := B
^
-Warning 18: this type-based constructor disambiguation is not principal.
+Warning 18 [not-principal]: this type-based constructor disambiguation is not principal.
val b : unit = ()
|}]
Line 4, characters 4-5:
4 | | B -> ()
^
-Error: Unbound constructor B
+Warning 18 [not-principal]: this type-based constructor disambiguation is not principal.
+val h : M.t -> unit = <fun>
|}]
let i x =
;;
[%%expect{|
val j : M.t -> unit = <fun>
+|}, Principal{|
+Line 4, characters 4-5:
+4 | | B -> ()
+ ^
+Warning 18 [not-principal]: this type-based constructor disambiguation is not principal.
+val j : M.t -> unit = <fun>
|}]
let k x =
Line 4, characters 4-20:
4 | | { contents = A } -> ()
^^^^^^^^^^^^^^^^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
val n : M.t ref -> unit = <fun>
|}, Principal{|
Line 4, characters 17-18:
4 | | { contents = A } -> ()
^
-Error: Unbound constructor A
+Warning 18 [not-principal]: this type-based constructor disambiguation is not principal.
+Line 4, characters 4-20:
+4 | | { contents = A } -> ()
+ ^^^^^^^^^^^^^^^^
+Warning 11 [redundant-case]: this match case is unused.
+val n : M.t ref -> unit = <fun>
|}]
let o x =
Line 4, characters 4-20:
4 | | { contents = A } -> ()
^^^^^^^^^^^^^^^^
-Warning 12: this sub-pattern is unused.
+Warning 12 [redundant-subpat]: this sub-pattern is unused.
+val p : M.t ref -> unit = <fun>
+|}, Principal{|
+Line 4, characters 17-18:
+4 | | { contents = A } -> ()
+ ^
+Warning 18 [not-principal]: this type-based constructor disambiguation is not principal.
+Line 4, characters 4-20:
+4 | | { contents = A } -> ()
+ ^^^^^^^^^^^^^^^^
+Warning 12 [redundant-subpat]: this sub-pattern is unused.
val p : M.t ref -> unit = <fun>
|}]
Line 4, characters 9-10:
4 | x := A
^
-Warning 18: this type-based constructor disambiguation is not principal.
+Warning 18 [not-principal]: this type-based constructor disambiguation is not principal.
val s : M.t ref -> unit = <fun>
|}]
1 | ........function
2 | | ({ contents = M.A } : M.t ref) as x ->
3 | x := B
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
{contents=B}
val t : M.t ref -> unit = <fun>
Line 3, characters 9-10:
3 | x := B
^
-Warning 18: this type-based constructor disambiguation is not principal.
+Warning 18 [not-principal]: this type-based constructor disambiguation is not principal.
Lines 1-3, characters 8-10:
1 | ........function
2 | | ({ contents = M.A } : M.t ref) as x ->
3 | x := B
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
{contents=B}
val t : M.t ref -> unit = <fun>
Lines 16-17, characters 8-18:
16 | ........match abc with
17 | | A _ -> 1
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
C ()
val f : unit -> unit = <fun>
Line 3, characters 22-42:
3 | let g (x:nothing t) = match x with A -> ()
^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
C
val g : nothing t -> unit = <fun>
--- /dev/null
+(* TEST
+ * expect
+*)
+
+(* Syntax *)
+
+type ! 'a t = private 'a ref
+type +! 'a t = private 'a
+type -!'a t = private 'a -> unit
+type + !'a t = private 'a
+type - ! 'a t = private 'a -> unit
+type !+ 'a t = private 'a
+type !-'a t = private 'a -> unit
+type ! +'a t = private 'a
+type ! -'a t = private 'a -> unit
+[%%expect{|
+type 'a t = private 'a ref
+type +'a t = private 'a
+type -'a t = private 'a -> unit
+type +'a t = private 'a
+type -'a t = private 'a -> unit
+type +'a t = private 'a
+type -'a t = private 'a -> unit
+type +'a t = private 'a
+type -'a t = private 'a -> unit
+|}]
+(* Expect doesn't support syntax errors
+type -+ 'a t
+[%%expect]
+type -!! 'a t
+[%%expect]
+*)
+
+(* Define an injective abstract type, and use it in a GADT
+ and a constrained type *)
+module M : sig type +!'a t end = struct type 'a t = 'a list end
+[%%expect{|
+module M : sig type +!'a t end
+|}]
+type _ t = M : 'a -> 'a M.t t (* OK *)
+type 'a u = 'b constraint 'a = 'b M.t
+[%%expect{|
+type _ t = M : 'a -> 'a M.t t
+type 'a u = 'b constraint 'a = 'b M.t
+|}]
+
+(* Without the injectivity annotation, the cannot be defined *)
+module N : sig type +'a t end = struct type 'a t = 'a list end
+[%%expect{|
+module N : sig type +'a t end
+|}]
+type _ t = N : 'a -> 'a N.t t (* KO *)
+[%%expect{|
+Line 1, characters 0-29:
+1 | type _ t = N : 'a -> 'a N.t t (* KO *)
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this definition, a type variable cannot be deduced
+ from the type parameters.
+|}]
+type 'a u = 'b constraint 'a = 'b N.t
+[%%expect{|
+Line 1, characters 0-37:
+1 | type 'a u = 'b constraint 'a = 'b N.t
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this definition, a type variable cannot be deduced
+ from the type parameters.
+|}]
+
+(* Of course, the internal type should be injective in this parameter *)
+module M : sig type +!'a t end = struct type 'a t = int end (* KO *)
+[%%expect{|
+Line 1, characters 33-59:
+1 | module M : sig type +!'a t end = struct type 'a t = int end (* KO *)
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+ Modules do not match:
+ sig type 'a t = int end
+ is not included in
+ sig type +!'a t end
+ Type declarations do not match:
+ type 'a t = int
+ is not included in
+ type +!'a t
+ Their variances do not agree.
+|}]
+
+(* Annotations in type abbreviations allow to check injectivity *)
+type !'a t = 'a list
+type !'a u = int
+[%%expect{|
+type 'a t = 'a list
+Line 2, characters 0-16:
+2 | type !'a u = int
+ ^^^^^^^^^^^^^^^^
+Error: In this definition, expected parameter variances are not satisfied.
+ The 1st type parameter was expected to be injective invariant,
+ but it is unrestricted.
+|}]
+type !'a t = private 'a list
+type !'a t = private int
+[%%expect{|
+type 'a t = private 'a list
+Line 2, characters 0-24:
+2 | type !'a t = private int
+ ^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this definition, expected parameter variances are not satisfied.
+ The 1st type parameter was expected to be injective invariant,
+ but it is unrestricted.
+|}]
+
+(* Can also use to add injectivity in private row types *)
+module M : sig type !'a t = private < m : int ; .. > end =
+ struct type 'a t = < m : int ; n : 'a > end
+type 'a u = M : 'a -> 'a M.t u
+[%%expect{|
+module M : sig type !'a t = private < m : int; .. > end
+type 'a u = M : 'a -> 'a M.t u
+|}]
+module M : sig type 'a t = private < m : int ; .. > end =
+ struct type 'a t = < m : int ; n : 'a > end
+type 'a u = M : 'a -> 'a M.t u
+[%%expect{|
+module M : sig type 'a t = private < m : int; .. > end
+Line 3, characters 0-30:
+3 | type 'a u = M : 'a -> 'a M.t u
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this definition, a type variable cannot be deduced
+ from the type parameters.
+|}]
+module M : sig type !'a t = private < m : int ; .. > end =
+ struct type 'a t = < m : int > end
+[%%expect{|
+Line 2, characters 2-36:
+2 | struct type 'a t = < m : int > end
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+ Modules do not match:
+ sig type 'a t = < m : int > end
+ is not included in
+ sig type !'a t = private < m : int; .. > end
+ Type declarations do not match:
+ type 'a t = < m : int >
+ is not included in
+ type !'a t
+ Their variances do not agree.
+|}]
+
+(* Injectivity annotations are inferred correctly for constrained parameters *)
+type 'a t = 'b constraint 'a = <b:'b>
+type !'b u = <b:'b> t
+[%%expect{|
+type 'a t = 'b constraint 'a = < b : 'b >
+type 'b u = < b : 'b > t
+|}]
+
+(* Ignore injectivity for nominal types *)
+type !_ t = X
+[%%expect{|
+type _ t = X
+|}]
+
+(* Beware of constrained parameters *)
+type (_,_) eq = Refl : ('a,'a) eq
+type !'a t = private 'b constraint 'a = < b : 'b > (* OK *)
+[%%expect{|
+type (_, _) eq = Refl : ('a, 'a) eq
+type 'a t = private 'b constraint 'a = < b : 'b >
+|}]
+
+type !'a t = private 'b constraint 'a = < b : 'b; c : 'c > (* KO *)
+module M : sig type !'a t constraint 'a = < b : 'b; c : 'c > end =
+ struct type nonrec 'a t = 'a t end
+let inj_t : type a b. (<b:_; c:a> M.t, <b:_; c:b> M.t) eq -> (a, b) eq =
+ fun Refl -> Refl
+[%%expect{|
+Line 1, characters 0-58:
+1 | type !'a t = private 'b constraint 'a = < b : 'b; c : 'c > (* KO *)
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this definition, expected parameter variances are not satisfied.
+ The 1st type parameter was expected to be injective invariant,
+ but it is unrestricted.
+|}]
+
+(* One cannot assume that abstract types are not injective *)
+module F(X : sig type 'a t end) = struct
+ type 'a u = unit constraint 'a = 'b X.t
+ type _ x = G : 'a -> 'a u x
+end
+module M = F(struct type 'a t = 'a end)
+let M.G (x : bool) = M.G 3
+[%%expect{|
+Line 3, characters 2-29:
+3 | type _ x = G : 'a -> 'a u x
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this definition, a type variable cannot be deduced
+ from the type parameters.
+|}]
+
+(* Try to be clever *)
+type 'a t = unit
+type !'a u = int constraint 'a = 'b t
+[%%expect{|
+type 'a t = unit
+type 'a u = int constraint 'a = 'b t
+|}]
+module F(X : sig type 'a t end) = struct
+ type !'a u = 'b constraint 'a = <b : 'b> constraint 'b = _ X.t
+end
+[%%expect{|
+module F :
+ functor (X : sig type 'a t end) ->
+ sig type 'a u = 'b X.t constraint 'a = < b : 'b X.t > end
+|}]
+(* But not too clever *)
+module F(X : sig type 'a t end) = struct
+ type !'a u = 'b X.t constraint 'a = <b : 'b X.t>
+end
+[%%expect{|
+Line 2, characters 2-50:
+2 | type !'a u = 'b X.t constraint 'a = <b : 'b X.t>
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this definition, expected parameter variances are not satisfied.
+ The 1st type parameter was expected to be injective invariant,
+ but it is unrestricted.
+|}]
+module F(X : sig type 'a t end) = struct
+ type !'a u = 'b constraint 'a = <b : _ X.t as 'b>
+end
+[%%expect{|
+module F :
+ functor (X : sig type 'a t end) ->
+ sig type 'a u = 'b X.t constraint 'a = < b : 'b X.t > end
+|}, Principal{|
+Line 2, characters 2-51:
+2 | type !'a u = 'b constraint 'a = <b : _ X.t as 'b>
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this definition, expected parameter variances are not satisfied.
+ The 1st type parameter was expected to be injective invariant,
+ but it is unrestricted.
+|}]
+
+(* Motivating examples with GADTs *)
+
+type (_,_) eq = Refl : ('a,'a) eq
+
+module Vec : sig
+ type +!'a t
+ val make : int -> (int -> 'a) -> 'a t
+ val get : 'a t -> int -> 'a
+end = struct
+ type 'a t = Vec of Obj.t array
+ let make n f = Vec (Obj.magic Array.init n f)
+ let get (Vec v) n = Obj.obj (Array.get v n)
+end
+
+type _ ty =
+ | Int : int ty
+ | Fun : 'a ty * 'b ty -> ('a -> 'b) ty
+ | Vec : 'a ty -> 'a Vec.t ty
+
+type dyn = Dyn : 'a ty * 'a -> dyn
+
+let rec eq_ty : type a b. a ty -> b ty -> (a,b) eq option =
+ fun t1 t2 -> match t1, t2 with
+ | Int, Int -> Some Refl
+ | Fun (t11, t12), Fun (t21, t22) ->
+ begin match eq_ty t11 t21, eq_ty t12 t22 with
+ | Some Refl, Some Refl -> Some Refl
+ | _ -> None
+ end
+ | Vec t1, Vec t2 ->
+ begin match eq_ty t1 t2 with
+ | Some Refl -> Some Refl
+ | None -> None
+ end
+ | _ -> None
+
+let undyn : type a. a ty -> dyn -> a option =
+ fun t1 (Dyn (t2, v)) ->
+ match eq_ty t1 t2 with
+ | Some Refl -> Some v
+ | None -> None
+
+let v = Vec.make 3 (fun n -> Vec.make n (fun m -> (m*n)))
+
+let int_vec_vec = Vec (Vec Int)
+
+let d = Dyn (int_vec_vec, v)
+
+let Some v' = undyn int_vec_vec d
+[%%expect{|
+type (_, _) eq = Refl : ('a, 'a) eq
+module Vec :
+ sig
+ type +!'a t
+ val make : int -> (int -> 'a) -> 'a t
+ val get : 'a t -> int -> 'a
+ end
+type _ ty =
+ Int : int ty
+ | Fun : 'a ty * 'b ty -> ('a -> 'b) ty
+ | Vec : 'a ty -> 'a Vec.t ty
+type dyn = Dyn : 'a ty * 'a -> dyn
+val eq_ty : 'a ty -> 'b ty -> ('a, 'b) eq option = <fun>
+val undyn : 'a ty -> dyn -> 'a option = <fun>
+val v : int Vec.t Vec.t = <abstr>
+val int_vec_vec : int Vec.t Vec.t ty = Vec (Vec Int)
+val d : dyn = Dyn (Vec (Vec Int), <poly>)
+Line 47, characters 4-11:
+47 | let Some v' = undyn int_vec_vec d
+ ^^^^^^^
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+None
+val v' : int Vec.t Vec.t = <abstr>
+|}]
+
+(* Break it (using magic) *)
+module Vec : sig
+ type +!'a t
+ val eqt : ('a t, 'b t) eq
+end = struct
+ type 'a t = 'a
+ let eqt = Obj.magic Refl (* Never do that! *)
+end
+
+type _ ty =
+ | Int : int ty
+ | Vec : 'a ty -> 'a Vec.t ty
+
+let coe : type a b. (a,b) eq -> a ty -> b ty =
+ fun Refl x -> x
+let eq_int_any : type a. unit -> (int, a) eq = fun () ->
+ let vec_ty : a Vec.t ty = coe Vec.eqt (Vec Int) in
+ let Vec Int = vec_ty in Refl
+[%%expect{|
+module Vec : sig type +!'a t val eqt : ('a t, 'b t) eq end
+type _ ty = Int : int ty | Vec : 'a ty -> 'a Vec.t ty
+val coe : ('a, 'b) eq -> 'a ty -> 'b ty = <fun>
+Line 17, characters 2-30:
+17 | let Vec Int = vec_ty in Refl
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+Vec (Vec Int)
+val eq_int_any : unit -> (int, 'a) eq = <fun>
+|}]
+
+(* Not directly related: injectivity and constraints *)
+type 'a t = 'b constraint 'a = <b : 'b>
+class type ['a] ct = object method m : 'b constraint 'a = < b : 'b > end
+[%%expect{|
+type 'a t = 'b constraint 'a = < b : 'b >
+class type ['a] ct = object constraint 'a = < b : 'b > method m : 'b end
+|}]
+
+type _ u = M : 'a -> 'a t u (* OK *)
+[%%expect{|
+type _ u = M : < b : 'a > -> < b : 'a > t u
+|}]
+type _ v = M : 'a -> 'a ct v (* OK *)
+[%%expect{|
+type _ v = M : < b : 'a > -> < b : 'a > ct v
+|}]
+
+type 'a t = 'b constraint 'a = <b : 'b; c : 'c>
+type _ u = M : 'a -> 'a t u (* KO *)
+[%%expect{|
+type 'a t = 'b constraint 'a = < b : 'b; c : 'c >
+Line 2, characters 0-27:
+2 | type _ u = M : 'a -> 'a t u (* KO *)
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this definition, a type variable cannot be deduced
+ from the type parameters.
+|}]
+
+
+(* #9721 by Jeremy Yallop *)
+
+(* First, some standard bits and pieces for equality & injectivity: *)
+
+type (_,_) eql = Refl : ('a, 'a) eql
+
+module Uninj(X: sig type !'a t end) :
+sig val uninj : ('a X.t, 'b X.t) eql -> ('a, 'b) eql end =
+struct let uninj : type a b. (a X.t, b X.t) eql -> (a, b) eql = fun Refl -> Refl end
+
+let coerce : type a b. (a, b) eql -> a -> b = fun Refl x -> x;;
+[%%expect{|
+type (_, _) eql = Refl : ('a, 'a) eql
+module Uninj :
+ functor (X : sig type !'a t end) ->
+ sig val uninj : ('a X.t, 'b X.t) eql -> ('a, 'b) eql end
+val coerce : ('a, 'b) eql -> 'a -> 'b = <fun>
+|}]
+
+(* Now the questionable part, defining two "injective" type definitions in
+ a pair of mutually-recursive modules. These definitions are correctly
+ rejected if given as a pair of mutually-recursive types, but wrongly
+ accepted when defined as follows:
+*)
+
+module rec R : sig type !'a t = [ `A of 'a S.t] end = R
+ and S : sig type !'a t = 'a R.t end = S ;;
+[%%expect{|
+Line 1, characters 19-47:
+1 | module rec R : sig type !'a t = [ `A of 'a S.t] end = R
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this definition, expected parameter variances are not satisfied.
+ The 1st type parameter was expected to be injective invariant,
+ but it is invariant.
+|}]
+
+(* The parameter of R.t is never used, so we can build an equality witness
+ for any instantiation: *)
+
+let x_eq_y : (int R.t, string R.t) eql = Refl
+let boom = let module U = Uninj(R) in print_endline (coerce (U.uninj x_eq_y) 0)
+;;
+[%%expect{|
+Line 1, characters 18-21:
+1 | let x_eq_y : (int R.t, string R.t) eql = Refl
+ ^^^
+Error: Unbound module R
+|}]
+
+(* #10028 by Stephen Dolan *)
+
+module rec A : sig
+ type _ t = Foo : 'a -> 'a A.s t
+ type 'a s = T of 'a
+end =
+ A
+;;
+[%%expect{|
+module rec A : sig type _ t = Foo : 'a -> 'a A.s t type 'a s = T of 'a end
+|}]
Line 2, characters 5-6:
2 | f ?x:0;;
^
-Warning 43: the label x is not optional.
+Warning 43 [nonoptional-label]: the label x is not optional.
- : int = 1
|}];;
Line 1, characters 51-52:
1 | let f g = ignore (g : ?x:int -> unit -> int); g ~x:3 () ;;
^
-Warning 18: using an optional argument here is not principal.
+Warning 18 [not-principal]: using an optional argument here is not principal.
val f : (?x:int -> unit -> int) -> int = <fun>
|}];;
Line 1, characters 46-47:
1 | let f g = ignore (g : ?x:int -> unit -> int); g ();;
^
-Warning 19: eliminated optional argument without principality.
+Warning 19 [non-principal-labels]: eliminated optional argument without principality.
val f : (?x:int -> unit -> int) -> int = <fun>
|}];;
Line 1, characters 45-46:
1 | let f g = ignore (g : x:int -> unit -> int); g ();;
^
-Warning 19: commuted an argument without principality.
+Warning 19 [non-principal-labels]: commuted an argument without principality.
val f : (x:int -> unit -> int) -> x:int -> int = <fun>
|}];;
--- /dev/null
+(* TEST
+ * expect
+*)
+
+(* #8907 *)
+
+module M = struct
+ type t = int
+ let f (x : [< `Foo of t & int & string]) = ()
+end;;
+[%%expect{|
+module M : sig type t = int val f : [< `Foo of t & int & string ] -> unit end
+|}]
+
+type t = int
+let f (x : [< `Foo of t & int & string]) = () ;;
+[%%expect{|
+type t = int
+val f : [< `Foo of t & int & string ] -> unit = <fun>
+|}]
Line 1, characters 49-51:
1 | let f (x : [< `A | `B]) = match x with `A | `B | `C -> 0;; (* warn *)
^^
-Warning 12: this sub-pattern is unused.
+Warning 12 [redundant-subpat]: this sub-pattern is unused.
val f : [< `A | `B ] -> int = <fun>
|}];;
let f (x : [`A | `B]) = match x with `A | `B | `C -> 0;; (* fail *)
Line 9, characters 0-41:
9 | function (`A|`B), _ -> 0 | _,(`A|`B) -> 1;;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(`AnyOtherTag, `AnyOtherTag)
- : [> `A | `B ] * [> `A | `B ] -> int = <fun>
Line 10, characters 0-29:
10 | function `B,1 -> 1 | _,1 -> 2;;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(_, 0)
Line 10, characters 21-24:
10 | function `B,1 -> 1 | _,1 -> 2;;
^^^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
- : [< `B ] * int -> int = <fun>
Line 11, characters 0-29:
11 | function 1,`B -> 1 | 1,_ -> 2;;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(0, _)
Line 11, characters 21-24:
11 | function 1,`B -> 1 | 1,_ -> 2;;
^^^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
- : int * [< `B ] -> int = <fun>
|}];;
Line 2, characters 0-24:
2 | function (`A x : t) -> x;;
^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
`<some private tag>
- : t -> string = <fun>
Line 1, characters 8-76:
1 | let f = function `AnyOtherTag, _ -> 1 | _, (`AnyOtherTag|`AnyOtherTag') -> 2;;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(`AnyOtherTag', `AnyOtherTag'')
val f : [> `AnyOtherTag ] * [> `AnyOtherTag | `AnyOtherTag' ] -> int = <fun>
Line 5, characters 38-41:
5 | let add_extra_info arg = arg.Foo.info.doc
^^^
-Warning 40: doc was selected from type Foo.info.
+Warning 40 [name-out-of-scope]: doc was selected from type Foo.info.
It is not visible in the current scope, and will not
be selected if the type becomes unknown.
val add_extra_info : Foo.t -> unit = <fun>
Line 8, characters 38-41:
8 | let add_extra_info arg = arg.Foo.info.doc
^^^
-Warning 40: doc was selected from type Bar/2.info.
+Warning 40 [name-out-of-scope]: doc was selected from type Bar/2.info.
It is not visible in the current scope, and will not
be selected if the type becomes unknown.
val add_extra_info : Foo.t -> unit = <fun>
Line 1, characters 12-19:
1 | let rec x = [| x |]; 1.;;
^^^^^^^
-Warning 10: this expression should have type unit.
+Warning 10 [non-unit-statement]: this expression should have type unit.
Line 1, characters 12-23:
1 | let rec x = [| x |]; 1.;;
^^^^^^^^^^^
Line 1, characters 12-19:
1 | let rec x = [| x |]; 1.;;
^^^^^^^
-Warning 10: this expression should have type unit.
+Warning 10 [non-unit-statement]: this expression should have type unit.
val x : float = 1.
|}];;
Line 1, characters 16-17:
1 | let rec x = let u = [|y|] in 10. and y = 1.;;
^
-Warning 26: unused variable u.
+Warning 26 [unused-var]: unused variable u.
val x : float = 10.
val y : float = 1.
|}];;
Types for tag `X are incompatible
|}, Principal{|
type 'a r = 'a constraint 'a = [< `X of int & 'a ]
-Line 3, characters 30-31:
+Line 3, characters 35-39:
3 | let f: 'a. 'a r -> 'a r = fun x -> true;;
- ^
-Error: This pattern matches values of type
+ ^^^^
+Error: This expression has type bool but an expression was expected of type
([< `X of 'b & 'a & 'c & 'd & 'e ] as 'a) r
- but a pattern was expected which matches values of type
- ([< `X of int & 'f ] as 'f) r
Types for tag `X are incompatible
|}]
but an expression was expected of type ([< `X of int & 'a ] as 'a) r
Types for tag `X are incompatible
|}, Principal{|
-Line 1, characters 30-31:
+Line 1, characters 35-51:
1 | let g: 'a. 'a r -> 'a r = fun x -> { contents = 0 };;
- ^
-Error: This pattern matches values of type
+ ^^^^^^^^^^^^^^^^
+Error: This expression has type int ref
+ but an expression was expected of type
([< `X of 'b & 'a & 'c & 'd & 'e ] as 'a) r
- but a pattern was expected which matches values of type
- ([< `X of int & 'f ] as 'f) r
Types for tag `X are incompatible
|}]
but a pattern was expected which matches values of type
([< `X of int & 'a ] as 'a) r
Types for tag `X are incompatible
-|}, Principal{|
-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 'b & 'a & 'c ] as 'a) r
- Types for tag `X are incompatible
|}]
but a pattern was expected which matches values of type
([< `X of int & 'a ] as 'a) r
Types for tag `X are incompatible
-|}, Principal{|
-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 'b & 'a & 'c ] as 'a) r
- Types for tag `X are incompatible
|}]
but the expected method type was 'a. 'a * ('a * < m : 'a. 'b >) as 'b
The universal variable 'a would escape its scope
|}]
+
+(* #9739
+ Recursive occurence checks are only done on type variables.
+ However, we are not guaranteed to still have a type variable when printing.
+*)
+
+let rec foo () = [42]
+and bar () =
+ let x = foo () in
+ x |> List.fold_left max 0 x
+[%%expect {|
+Line 4, characters 7-29:
+4 | x |> List.fold_left max 0 x
+ ^^^^^^^^^^^^^^^^^^^^^^
+Error: This expression has type int but an expression was expected of type
+ int list -> 'a
+|}]
Line 1, characters 8-44:
1 | let r = { (assert false) with contents = 1 } ;;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 23: all the fields are explicitly listed in this record:
+Warning 23 [useless-record-with]: all the fields are explicitly listed in this record:
the 'with' clause is useless.
Exception: Assert_failure ("", 1, 10).
|}]
This argument cannot be applied with label ~y
|}]
-let f ?x ~a ?y ~z = ()
+let f ?x ~a ?y ~z () = ()
let g = f ?y:None ?x:None ~a:()
[%%expect {|
-val f : ?x:'a -> a:'b -> ?y:'c -> z:'d -> unit = <fun>
+val f : ?x:'a -> a:'b -> ?y:'c -> z:'d -> unit -> unit = <fun>
Line 2, characters 13-17:
2 | let g = f ?y:None ?x:None ~a:()
^^^^
Error: The function applied to this argument has type
- ?x:'a -> a:'b -> ?y:'c -> z:'d -> unit
+ ?x:'a -> a:'b -> ?y:'c -> z:'d -> unit -> unit
This argument cannot be applied with label ?y
Since OCaml 4.11, optional arguments do not commute when -nolabels is given
|}]
let f: (module Original.T with type t = int) -> unit = fun _ -> ()
let x = (module struct type t end: Original.T )
let g: (module Original.T) -> unit = fun _ -> ()
+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)
Error: Signature mismatch:
Modules do not match: sig end is not included in Original.T
|}]
+
+let foo (x : Middle.pack1) =
+ let module M = (val x) in
+ ()
+[%%expect {|
+Line 2, characters 17-24:
+2 | let module M = (val x) in
+ ^^^^^^^
+Error: The type of this packed module refers to Original.T, which is missing
+|}]
+
+let foo (x : Middle.pack2) =
+ let module M = (val x) in
+ ()
+[%%expect {|
+Line 2, characters 17-24:
+2 | let module M = (val x) in
+ ^^^^^^^
+Error: The type of this packed module refers to Original.T, which is missing
+|}]
+
+module type T1 = sig type t = int end
+let foo x = (x : Middle.pack1 :> (module T1))
+[%%expect {|
+module type T1 = sig type t = int end
+Line 2, characters 12-45:
+2 | let foo x = (x : Middle.pack1 :> (module T1))
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Type Middle.pack1 = (module Original.T with type t = int)
+ is not a subtype of (module T1)
+|}]
+
+module type T2 = sig module M : sig type t = int end end
+let foo x = (x : Middle.pack2 :> (module T2))
+[%%expect {|
+module type T2 = sig module M : sig type t = int end end
+Line 2, characters 12-45:
+2 | let foo x = (x : Middle.pack2 :> (module T2))
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Type Middle.pack2 = (module Middle.T with type M.t = int)
+ is not a subtype of (module T2)
+|}]
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
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
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
- : bool = true
|}];;
-(* PR#3476 *)
-(* Does not work yet *)
+(* PR#3476: *)
module FF(X : sig end) = struct type t end
module M = struct
module X = struct end
- module Y = FF (X) (* XXX *)
+ module Y = FF (X)
type t = Y.t
end
module F (Y : sig type t end) (M : sig type t = Y.t end) = struct end;;
module G = F (M.Y);;
-(*module N = G (M);;
-module N = F (M.Y) (M);;*)
+module N = G (M);;
+module N = F (M.Y) (M);;
[%%expect{|
module FF : functor (X : sig end) -> sig type t end
module M :
sig module X : sig end module Y : sig type t = FF(X).t end type t = Y.t end
module F : functor (Y : sig type t end) (M : sig type t = Y.t end) -> sig end
module G : functor (M : sig type t = M.Y.t end) -> sig end
+module N : sig end
+module N : sig end
|}];;
+(* PR#5058 *)
+module F (M : sig end) : sig type t end = struct type t = int end
+module T = struct
+module M = struct end
+include F(M)
+end
+include T
+let f (x : t) : T.t = x
+[%%expect {|
+module F : functor (M : sig end) -> sig type t end
+module T : sig module M : sig end type t = F(M).t end
+module M = T.M
+type t = F(M).t
+val f : t -> T.t = <fun>
+|}]
+
(* PR#6307 *)
module A1 = struct end
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
is not included in
Set.OrderedType
The value `compare' is required but not provided
- File "set.mli", line 52, characters 4-31: Expected declaration
+ File "set.mli", line 55, characters 4-31: Expected declaration
|} ]
The parameter cannot be eliminated in the result type.
Please bind the argument to a module identifier.
|}]
+
+module M (X : sig type 'a t constraint 'a = float end) = struct
+ module type S = sig
+ type t = float
+ val foo : t X.t
+ end
+end
+
+module N = M (struct type 'a t = int constraint 'a = float end)
+
+[%%expect{|
+module M :
+ functor (X : sig type 'a t constraint 'a = float end) ->
+ sig module type S = sig type t = float val foo : t X.t end end
+module N : sig module type S = sig type t = float val foo : int end end
+|}]
--- /dev/null
+(* TEST
+ * expect
+*)
+
+
+(* If a module is used as a module type it should trigger the hint. *)
+module Equal = struct end
+module Foo = functor (E : Equal) -> struct end;;
+[%%expect{|
+module Equal : sig end
+Line 2, characters 26-31:
+2 | module Foo = functor (E : Equal) -> struct end;;
+ ^^^^^
+Error: Unbound module type Equal
+Hint: There is a module named Equal, but modules are not module types
+|}]
+
+(* If there is a typo in the module type name it should trigger the
+ spellcheck.
+*)
+module type Equals = sig end
+module Foo = functor (E : EqualF) -> struct end;;
+[%%expect{|
+module type Equals = sig end
+Line 2, characters 26-32:
+2 | module Foo = functor (E : EqualF) -> struct end;;
+ ^^^^^^
+Error: Unbound module type EqualF
+Hint: Did you mean Equals?
+|}]
+
+(* If a module is used as a module type it should trigger the hint
+ (even it is a typo). *)
+module type Equal = sig end
+module EqualF = struct end
+module Foo = functor (E : EqualF) -> struct end;;
+[%%expect{|
+module type Equal = sig end
+module EqualF : sig end
+Line 3, characters 26-32:
+3 | module Foo = functor (E : EqualF) -> struct end;;
+ ^^^^^^
+Error: Unbound module type EqualF
+Hint: There is a module named EqualF, but modules are not module types
+|}]
+
+(* If a module type is used as a module it should trigger the hint. *)
+module type S = sig type t val show: t -> string end
+let f (x: S.t ) = ();;
+[%%expect{|
+module type S = sig type t val show : t -> string end
+Line 2, characters 10-13:
+2 | let f (x: S.t ) = ();;
+ ^^^
+Error: Unbound module S
+Hint: There is a module type named S, but module types are not modules
+|}]
+
+(* If a class type is used as a class it should trigger the hint. *)
+class type ct = object method m: int end
+class c = object inherit ct end
+[%%expect{|
+class type ct = object method m : int end
+Line 2, characters 25-27:
+2 | class c = object inherit ct end
+ ^^
+Error: Unbound class ct
+Hint: There is a class type named ct, but classes are not class types
+|}]
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
File "pr7284_bad.ml", line 35, characters 30-62:
35 | let f : X.v1 wit -> unit = function V1 s -> print_endline s
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error (warning 8): this pattern-matching is not exhaustive.
+Error (warning 8 [partial-match]): this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
V2 _
Line 3, characters 10-27:
3 | inherit printable_point y as super
^^^^^^^^^^^^^^^^^
-Warning 13: the following instance variables are overridden by the class printable_point :
+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 :
Line 2, characters 2-69:
2 | List.map (fun c -> Format.print_int c#x; Format.print_string " ") l;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 10: this expression should have type unit.
+Warning 10 [non-unit-statement]: this expression should have type unit.
val pr : < x : int; .. > list -> unit = <fun>
|}];;
let l = [new int_comparable 5; (new int_comparable3 2 :> int_comparable);
Line 3, characters 10-13:
3 | inherit c 5
^^^
-Warning 13: the following instance variables are overridden by the class c :
+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: the instance variable y is overridden.
+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:
6 | inherit d 7
^^^
-Warning 13: the following instance variables are overridden by the class d :
+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: the instance variable u is overridden.
+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 ->
Line 1, characters 18-26:
1 | fun (x : 'a t) -> (x : 'a); ();;
^^^^^^^^
-Warning 10: this expression should have type unit.
+Warning 10 [non-unit-statement]: this expression should have type unit.
- : ('a t as 'a) t -> unit = <fun>
|}];;
File "pervasives_leitmotiv.ml", line 1:
-Warning 63: The printed interface differs from the inferred interface.
+Warning 63 [erroneous-printed-signature]: The printed interface differs from the inferred interface.
The inferred interface contained items which could not be printed
properly due to name collisions between identifiers.
File "pervasives_leitmotiv.ml", lines 10-12, characters 0-3:
File "pr4791.ml", line 1:
-Warning 63: The printed interface differs from the inferred interface.
+Warning 63 [erroneous-printed-signature]: The printed interface differs from the inferred interface.
The inferred interface contained items which could not be printed
properly due to name collisions between identifiers.
File "pr4791.ml", line 11, characters 2-12:
File "pr6323.ml", line 1:
-Warning 63: The printed interface differs from the inferred interface.
+Warning 63 [erroneous-printed-signature]: The printed interface differs from the inferred interface.
The inferred interface contained items which could not be printed
properly due to name collisions between identifiers.
File "pr6323.ml", line 15, characters 2-24:
File "pr7402.ml", line 1:
-Warning 63: The printed interface differs from the inferred interface.
+Warning 63 [erroneous-printed-signature]: The printed interface differs from the inferred interface.
The inferred interface contained items which could not be printed
properly due to name collisions between identifiers.
File "pr7402.ml", lines 14-16, characters 0-5:
2 | | {pv=[]} -> "OK"
3 | | {pv=5::_} -> "int"
4 | | {pv=true::_} -> "bool"
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
{pv=false::_}
- : string = "OK"
2 | | {pv=[]} -> "OK"
3 | | {pv=true::_} -> "bool"
4 | | {pv=5::_} -> "int"
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
{pv=0::_}
- : string = "OK"
Line 8, characters 4-16:
8 | self#tl#fold ~f ~init:(f self#hd init)
^^^^^^^^^^^^
-Warning 18: this use of a polymorphic method is not principal.
+Warning 18 [not-principal]: this use of a polymorphic method is not principal.
class ['a] ostream1 :
hd:'a ->
tl:'b ->
Line 4, characters 11-60:
4 | let f () = object method private n = 1 method m = {<>}#n end;;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 15: the following private methods were made public implicitly:
+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 2, characters 9-16:
2 | fun x -> (f x)#m;; (* Warning 18 *)
^^^^^^^
-Warning 18: this use of a polymorphic method is not principal.
+Warning 18 [not-principal]: this use of a polymorphic method is not principal.
- : < m : 'a. 'a -> 'a > -> 'b -> 'b = <fun>
val f : < m : 'a. 'a -> 'a > * 'b -> < m : 'a. 'a -> 'a > = <fun>
Line 4, characters 9-20:
4 | fun x -> (f (x,x))#m;; (* Warning 18 *)
^^^^^^^^^^^
-Warning 18: this use of a polymorphic method is not principal.
+Warning 18 [not-principal]: this use of a polymorphic method is not principal.
- : < m : 'a. 'a -> 'a > -> 'b -> 'b = <fun>
val f : < m : 'a. 'a -> 'a > -> < m : 'a. 'a -> 'a > array = <fun>
Line 6, characters 9-20:
6 | fun x -> (f x).(0)#m;; (* Warning 18 *)
^^^^^^^^^^^
-Warning 18: this use of a polymorphic method is not principal.
+Warning 18 [not-principal]: this use of a polymorphic method is not principal.
- : < m : 'a. 'a -> 'a > -> 'b -> 'b = <fun>
|}];;
Line 4, characters 42-62:
4 | let f x = let l = [Some x; (None : u)] in (just(List.hd l))#id;;
^^^^^^^^^^^^^^^^^^^^
-Warning 18: this use of a polymorphic method is not principal.
+Warning 18 [not-principal]: this use of a polymorphic method is not principal.
val f : c -> 'a -> 'a = <fun>
Line 7, characters 36-47:
7 | let x = List.hd [Some x; none] in (just x)#id;;
^^^^^^^^^^^
-Warning 18: this use of a polymorphic method is not principal.
+Warning 18 [not-principal]: this use of a polymorphic method is not principal.
val g : c -> 'a -> 'a = <fun>
val h : < id : 'a; .. > -> 'a = <fun>
|}];;
- : ('a -> 'a) * ('b -> 'b) = (<fun>, <fun>)
|}];;
-(* PR#6747 *)
+(* PR#6744 *)
(* ok *)
let n = object
method m : 'x 'o. ([< `Foo of 'x] as 'o) -> 'x = fun x -> assert false
< m : 'a. [< `Foo of int ] -> 'a >
The universal variable 'x would escape its scope
|}];;
+(* ok *)
+let f (n : < m : 'a 'r. [< `Foo of 'a & int | `Bar] as 'r >) =
+ (n : < m : 'b 'r. [< `Foo of 'b & int | `Bar] as 'r >)
+[%%expect{|
+val f :
+ < m : 'a 'c. [< `Bar | `Foo of 'a & int ] as 'c > ->
+ < m : 'b 'd. [< `Bar | `Foo of 'b & int ] as 'd > = <fun>
+|}]
+(* fail? *)
+let f (n : < m : 'a 'r. [< `Foo of 'a & int | `Bar] as 'r >) =
+ (n : < m : 'b 'r. [< `Foo of int & 'b | `Bar] as 'r >)
+[%%expect{|
+Line 2, characters 3-4:
+2 | (n : < m : 'b 'r. [< `Foo of int & 'b | `Bar] as 'r >)
+ ^
+Error: This expression has type
+ < m : 'a 'c. [< `Bar | `Foo of 'a & int ] as 'c >
+ but an expression was expected of type
+ < m : 'b 'd. [< `Bar | `Foo of int & 'b ] as 'd >
+ Types for tag `Foo are incompatible
+|}]
+(* fail? *)
+let f (n : < m : 'a. [< `Foo of 'a & int | `Bar] >) =
+ (n : < m : 'b. [< `Foo of 'b & int | `Bar] >)
+[%%expect{|
+Line 1:
+Error: Values do not match:
+ val f :
+ < m : 'a. [< `Bar | `Foo of 'a & int ] as 'c > -> < m : 'b. 'c >
+ is not included in
+ val f :
+ < m : 'a. [< `Bar | `Foo of 'b & int ] as 'c > -> < m : 'b. 'c >
+|}]
(* PR#6171 *)
let f b (x: 'x) =
is not compatible with type < left : 'left0; right : 'right0 > pair
The method left has type 'a, but the expected method type was 'left
The universal variable 'left would escape its scope
-|}, Principal{|
-Line 4, characters 6-7:
-4 | = fun x -> x
- ^
-Error: This pattern matches values of type
- < m : 'left 'right. < left : 'left; right : 'right > pair >
- but a pattern was expected which matches values of type
- < m : 'left 'right. < left : 'left; right : 'right > pair >
- Type < left : 'left; right : 'right > pair = 'a * 'b
- is not compatible with type < left : 'left0; right : 'right0 > pair
- The method left has type 'a, but the expected method type was 'left
- The universal variable 'left would escape its scope
|}]
Lines 4-5, characters 2-38:
4 | ..match [] with
5 | | _::_ -> (x :> [`A | `C] Element.t)
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
[]
val f : [ `A ] Element.t -> [ `A | `C ] Element.t = <fun>
type t = private < x : int >
Line 1:
Error: Type declarations do not match:
- type 'a t = private 'a constraint 'a = < x : int; .. >
+ type !'a t = private 'a constraint 'a = < x : int; .. >
is not included in
type 'a t
Their constraints differ.
type t = private < x : int >
Line 1:
Error: Type declarations do not match:
- type 'a t = private < x : int; .. > constraint 'a = 'a t
+ type !'a t = private < x : int; .. > constraint 'a = 'a t
is not included in
type 'a t
Their constraints differ.
File "b_bad.ml", lines 13-14, characters 29-28:
13 | .............................function
14 | A.X s -> print_endline s
-Error (warning 8): this pattern-matching is not exhaustive.
+Error (warning 8 [partial-match]): this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
Y
File "b_bad.ml", line 18, characters 11-14:
(* TEST
modules = "largeFile.ml"
*)
-print_string LargeFile.message
+print_endline LargeFile.message
val map : ('a -> 'b) -> 'a t -> 'b t
val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
val to_seq : 'a t -> (key * 'a) Seq.t
+ val to_rev_seq : 'a t -> (key * 'a) Seq.t
val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
val of_seq : (key * 'a) Seq.t -> 'a t
Line 3, characters 2-36:
3 | include Comparable with type t = t
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: Illegal shadowing of included type t/97 by t/101
+Error: Illegal shadowing of included type t/98 by t/102
Line 2, characters 2-19:
- Type t/97 came from this include
+ Type t/98 came from this include
Line 3, characters 2-23:
- The value print has no valid type if t/97 is shadowed
+ The value print has no valid type if t/98 is shadowed
|}]
module type Sunderscore = sig
Line 2, characters 0-34:
2 | external id : i -> i = "%identity";;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 61: This primitive declaration uses type i, whose representation
+Warning 61 [unboxable-type-in-prim-decl]: This primitive declaration uses type i, whose representation
may be either boxed or unboxed. Without an annotation to indicate
which representation is intended, the boxed representation has been
selected by default. This default choice may change in future
Line 3, characters 0-34:
3 | external id : i -> j = "%identity";;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 61: This primitive declaration uses type i, whose representation
+Warning 61 [unboxable-type-in-prim-decl]: This primitive declaration uses type i, whose representation
may be either boxed or unboxed. Without an annotation to indicate
which representation is intended, the boxed representation has been
selected by default. This default choice may change in future
Line 3, characters 0-34:
3 | external id : i -> j = "%identity";;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 61: This primitive declaration uses type j, whose representation
+Warning 61 [unboxable-type-in-prim-decl]: This primitive declaration uses type j, whose representation
may be either boxed or unboxed. Without an annotation to indicate
which representation is intended, the boxed representation has been
selected by default. This default choice may change in future
Line 2, characters 4-29:
2 | | ((Val x, _) | (_, Val x)) when x < 0 -> ()
^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 57: Ambiguous or-pattern variables under guard;
+Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
variable x may match different arguments. (See manual section 9.5)
val ambiguous_typical_example : expr * expr -> unit = <fun>
|}]
Line 2, characters 4-43:
2 | | (`B (x, _, Some y) | `B (x, Some y, _)) when y -> ignore x
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 57: Ambiguous or-pattern variables under guard;
+Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
variable y may match different arguments. (See manual section 9.5)
val ambiguous__y : [> `B of 'a * bool option * bool option ] -> unit = <fun>
|}]
Line 2, characters 4-43:
2 | | (`B (x, _, Some y) | `B (x, Some y, _)) when x < y -> ()
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 57: Ambiguous or-pattern variables under guard;
+Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
variable y may match different arguments. (See manual section 9.5)
val ambiguous__x_y : [> `B of 'a * 'a option * 'a option ] -> unit = <fun>
|}]
Line 2, characters 4-43:
2 | | (`B (x, z, Some y) | `B (x, Some y, z)) when x < y || Some x = z -> ()
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 57: Ambiguous or-pattern variables under guard;
+Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
variables y,z may match different arguments. (See manual section 9.5)
val ambiguous__x_y_z : [> `B of 'a * 'a option * 'a option ] -> unit = <fun>
|}]
Line 2, characters 4-40:
2 | | `A (`B (Some x, _) | `B (_, Some x)) when x -> ()
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 57: Ambiguous or-pattern variables under guard;
+Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
variable x may match different arguments. (See manual section 9.5)
val ambiguous__in_depth :
[> `A of [> `B of bool option * bool option ] ] -> unit = <fun>
Lines 2-3, characters 4-58:
2 | ....`A ((`B (Some x, _) | `B (_, Some x)),
3 | (`C (Some y, Some _, _) | `C (Some y, _, Some _))).................
-Warning 57: Ambiguous or-pattern variables under guard;
+Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
variable x may match different arguments. (See manual section 9.5)
val ambiguous__first_orpat :
[> `A of
Lines 2-3, characters 4-42:
2 | ....`A ((`B (Some x, Some _, _) | `B (Some x, _, Some _)),
3 | (`C (Some y, _) | `C (_, Some y))).................
-Warning 57: Ambiguous or-pattern variables under guard;
+Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
variable y may match different arguments. (See manual section 9.5)
val ambiguous__second_orpat :
[> `A of
Lines 2-3, characters 2-17:
2 | ..X (Z x,Y (y,0))
3 | | X (Z y,Y (x,_))
-Warning 57: Ambiguous or-pattern variables under guard;
+Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
variables x,y may match different arguments. (See manual section 9.5)
val ambiguous__amoi : amoi -> int = <fun>
|}]
Lines 2-3, characters 4-24:
2 | ....(module M:S),_,(1,_)
3 | | _,(module M:S),(_,1)...................
-Warning 57: Ambiguous or-pattern variables under guard;
+Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
variable M may match different arguments. (See manual section 9.5)
val ambiguous__module_variable :
(module S) * (module S) * (int * int) -> bool -> int = <fun>
Line 2, characters 12-13:
2 | | (module M:S),_,(1,_)
^
-Warning 60: unused module M.
+Warning 60 [unused-module]: unused module M.
val not_ambiguous__module_variable :
(module S) * (module S) * (int * int) -> bool -> int = <fun>
|}]
Line 2, characters 4-5:
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 41: A belongs to several types: t2 t
+Warning 41 [ambiguous-name]: A belongs to several types: t2 t
The first one was selected. Please disambiguate if this is wrong.
Lines 1-3, characters 41-10:
1 | .........................................function
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
3 | | _ -> 2
-Warning 4: this pattern-matching is fragile.
+Warning 4 [fragile-match]: this pattern-matching is fragile.
It will remain exhaustive when constructors are added to type t2.
Line 2, characters 4-56:
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 or-pattern variables under guard;
+Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
+variables x,y may match different arguments. (See manual section 9.5)
+val ambiguous_xy_but_not_ambiguous_z : (int -> int -> bool) -> t2 -> int =
+ <fun>
+|}, Principal{|
+Line 2, characters 4-5:
+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 41 [ambiguous-name]: A belongs to several types: t2 t
+The first one was selected. Please disambiguate if this is wrong.
+Line 2, characters 24-25:
+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 41 [ambiguous-name]: A belongs to several types: t2 t
+The first one was selected. Please disambiguate if this is wrong.
+Line 2, characters 42-43:
+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 41 [ambiguous-name]: B belongs to several types: t2 t
+The first one was selected. Please disambiguate if this is wrong.
+Lines 1-3, characters 41-10:
+1 | .........................................function
+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
+3 | | _ -> 2
+Warning 4 [fragile-match]: this pattern-matching is fragile.
+It will remain exhaustive when constructors are added to type t2.
+Line 2, characters 4-56:
+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 9.5)
val ambiguous_xy_but_not_ambiguous_z : (int -> int -> bool) -> t2 -> int =
<fun>
Line 3, characters 4-29:
3 | | ((Val y, _) | (_, Val y)) when y < 0 -> ()
^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 57: Ambiguous or-pattern variables under guard;
+Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
variable y may match different arguments. (See manual section 9.5)
val guarded_ambiguity : expr * expr -> unit = <fun>
|}]
Line 4, characters 4-29:
4 | | ((Val x, _) | (_, Val x)) when pred x -> ()
^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 57: Ambiguous or-pattern variables under guard;
+Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
variable x may match different arguments. (See manual section 9.5)
val cmp : (a -> bool) -> a alg -> a alg -> unit = <fun>
|}]
Line 1, characters 8-22:
1 | let _ = Array.get [||];;
^^^^^^^^^^^^^^
-Warning 5: this function application is partial,
+Warning 5 [ignored-partial-application]: this function application is partial,
maybe some arguments are missing.
- : int -> 'a = <fun>
|}]
Line 1, characters 16-32:
1 | let () = ignore (Array.get [||]);;
^^^^^^^^^^^^^^^^
-Warning 5: this function application is partial,
+Warning 5 [ignored-partial-application]: this function application is partial,
maybe some arguments are missing.
|}]
Line 1, characters 21-35:
1 | let _ = if true then Array.get [||] else (fun _ -> 12);;
^^^^^^^^^^^^^^
-Warning 5: this function application is partial,
+Warning 5 [ignored-partial-application]: this function application is partial,
maybe some arguments are missing.
- : int -> int = <fun>
|}]
Line 1, characters 18-23:
1 | let f x = let _ = x.r 1 in ();;
^^^^^
-Warning 5: this function application is partial,
+Warning 5 [ignored-partial-application]: this function application is partial,
maybe some arguments are missing.
val f : t -> unit = <fun>
|}]
Line 1, characters 19-20:
1 | let _ = raise Exit 3;;
^
-Warning 20: this argument will not be used by the function.
+Warning 20 [ignored-extra-argument]: this argument will not be used by the function.
Exception: Stdlib.Exit.
|}]
+
+let f a b = a + b;;
+[%%expect {|
+val f : int -> int -> int = <fun>
+|}]
+let g x = x + 1
+let _ = g (f 1);;
+[%%expect {|
+val g : int -> int = <fun>
+Line 2, characters 10-15:
+2 | let _ = g (f 1);;
+ ^^^^^
+Warning 5 [ignored-partial-application]: this function application is partial,
+maybe some arguments are missing.
+Line 2, characters 10-15:
+2 | let _ = g (f 1);;
+ ^^^^^
+Error: This expression has type int -> int
+ but an expression was expected of type int
+|}]
Line 1, characters 45-48:
1 | fun b -> if b then format_of_string "x" else "y"
^^^
-Warning 18: this coercion to format6 is not principal.
+Warning 18 [not-principal]: this coercion to format6 is not principal.
- : bool -> ('a, 'b, 'c, 'd, 'd, 'a) format6 = <fun>
|}]
;;
Line 3, characters 49-59:
3 | let f x = let y = if true then x else (x:t) in (y :> int)
^^^^^^^^^^
-Warning 18: this ground coercion is not principal.
+Warning 18 [not-principal]: this ground coercion is not principal.
module Test1 : sig type t = private int val f : t -> int end
|}]
* expect
*)
-(* Warn about all relevant cases when possible *)
let f = function
None, None -> 1
| Some _, Some _ -> 2;;
1 | ........function
2 | None, None -> 1
3 | | Some _, Some _ -> 2..
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
-((Some _, None)|(None, Some _))
+(None, Some _)
val f : 'a option * 'b option -> int = <fun>
|}]
-(* Exhaustiveness check is very slow *)
type _ t =
A : int t | B : bool t | C : char t | D : float t
type (_,_,_,_) u = U : (int, int, int, int) u
type v = E | F | G
|}]
-let f : type a b c d e f g.
- a t * b t * c t * d t * e t * f t * g t * v
- * (a,b,c,d) u * (e,f,g,g) u -> int =
- function A, A, A, A, A, A, A, _, U, U -> 1
- | _, _, _, _, _, _, _, G, _, _ -> 1
- (*| _ -> _ *)
-;;
-[%%expect {|
-Lines 4-5, characters 1-38:
-4 | .function A, A, A, A, A, A, A, _, U, U -> 1
-5 | | _, _, _, _, _, _, _, G, _, _ -> 1
-Warning 8: this pattern-matching is not exhaustive.
-Here is an example of a case that is not matched:
-(A, A, A, A, A, A, B, (E|F), _, _)
-Line 5, characters 5-33:
-5 | | _, _, _, _, _, _, _, G, _, _ -> 1
- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 56: this match case is unreachable.
-Consider replacing it with a refutation case '<pat> -> .'
-val f :
- 'a t * 'b t * 'c t * 'd t * 'e t * 'f t * 'g t * v * ('a, 'b, 'c, 'd) u *
- ('e, 'f, 'g, 'g) u -> int = <fun>
-|}]
-
(* Unused cases *)
let f (x : int t) = match x with A -> 1 | _ -> 2;; (* warn *)
[%%expect {|
Line 1, characters 20-48:
1 | let f (x : int t) = match x with A -> 1 | _ -> 2;; (* warn *)
^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 4: this pattern-matching is fragile.
+Warning 4 [fragile-match]: this pattern-matching is fragile.
It will remain exhaustive when constructors are added to type t.
Line 1, characters 42-43:
1 | let f (x : int t) = match x with A -> 1 | _ -> 2;; (* warn *)
^
-Warning 56: this match case is unreachable.
+Warning 56 [unreachable-case]: this match case is unreachable.
Consider replacing it with a refutation case '<pat> -> .'
val f : int t -> int = <fun>
|}]
Line 1, characters 53-54:
1 | let f (x : unit t option) = match x with None -> 1 | _ -> 2 ;; (* warn? *)
^
-Warning 56: this match case is unreachable.
+Warning 56 [unreachable-case]: this match case is unreachable.
Consider replacing it with a refutation case '<pat> -> .'
val f : unit t option -> int = <fun>
|}]
Line 1, characters 53-59:
1 | let f (x : unit t option) = match x with None -> 1 | Some _ -> 2 ;; (* warn *)
^^^^^^
-Warning 56: this match case is unreachable.
+Warning 56 [unreachable-case]: this match case is unreachable.
Consider replacing it with a refutation case '<pat> -> .'
val f : unit t option -> int = <fun>
|}]
Line 1, characters 27-49:
1 | let f (x : int t option) = match x with None -> 1;; (* warn *)
^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
Some A
val f : int t option -> int = <fun>
Line 1, characters 49-68:
1 | let f : (int t box pair * bool) option -> unit = function None -> ();;
^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
Some ({left=Box A; right=Box A}, _)
val f : (int t box pair * bool) option -> unit = <fun>
Line 1, characters 8-39:
1 | let f = function {left=Box 0; _ } -> ();;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
{left=Box 1; _ }
val f : int box pair -> unit = <fun>
Line 1, characters 8-47:
1 | let f = function {left=Box 0;right=Box 1} -> ();;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
-({left=Box 0; right=Box 0}|{left=Box 1; right=Box _})
+{left=Box 0; right=Box 0}
val f : int box pair -> unit = <fun>
|}]
Line 1, characters 33-51:
1 | let f : (A.a, A.b) cmp -> unit = function Any -> ()
^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
Eq
val f : (A.a, A.b) cmp -> unit = <fun>
Line 2, characters 2-24:
2 | function None -> false
^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
Some (PlusS _)
val harder : (zero succ, zero succ, zero succ) plus option -> bool = <fun>
Line 1, characters 12-42:
1 | let f x y = match 1 with 1 when x = y -> 1;;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
All clauses in this pattern-matching are guarded.
val f : 'a -> 'a -> int = <fun>
|}]
Line 1, characters 8-37:
1 | let f = function {contents=_}, 0 -> 0;;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(_, 1)
val f : 'a ref * int -> int = <fun>
2 | | None -> ()
3 | | Some x when x > 0 -> ()
4 | | Some x when x <= 0 -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
Some _
(However, some guarded clause may match this value.)
val f : int option -> unit = <fun>
|}]
+
+(* in the single-row case we can generate more compact witnesses *)
+module Single_row_optim = struct
+type t = A | B
+
+(* This synthetic program is representative of user-written programs
+ that try to distinguish the cases "only A" and "at least one B"
+ while avoiding a fragile pattern-matching (using just _ in the last
+ row would be fragile).
+
+ It is a "single row" program from the point of view of
+ exhaustiveness checking because the first row is subsumed by the
+ second and thus removed by the [get_mins] preprocessing of
+ Parmatch.
+
+ With the single-row optimization implemented in the compiler, it
+ generates a single counter-example that contains
+ or-patterns. Without this optimization, it would generate 2^(N-1)
+ counter-examples (here N=4 so 8), one for each possible expansion
+ of the or-patterns.
+*)
+let non_exhaustive : t * t * t * t -> unit = function
+| A, A, A, A -> ()
+| (A|B), (A|B), (A|B), A (*missing B here*) -> ()
+end;;
+[%%expect {|
+Lines 20-22, characters 45-49:
+20 | .............................................function
+21 | | A, A, A, A -> ()
+22 | | (A|B), (A|B), (A|B), A (*missing B here*) -> ()
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+((A|B), (A|B), (A|B), B)
+module Single_row_optim :
+ sig type t = A | B val non_exhaustive : t * t * t * t -> unit end
+|}]
--- /dev/null
+(* TEST *)
+
+(* Tests for stack-overflow crashes caused by a combinatorial
+ explosition in fragile pattern checking. *)
+
+[@@@warning "+4"]
+
+module SyntheticTest = struct
+ (* from Luc Maranget *)
+ type t = A | B
+
+ let f = function
+ | A,A,A,A,A, A,A,A,A,A, A,A,A,A,A, A,A,A -> 1
+ | (A|B),(A|B),(A|B),(A|B),(A|B),
+ (A|B),(A|B),(A|B),(A|B),(A|B),
+ (A|B),(A|B),(A|B),(A|B),(A|B),
+ (A|B),(A|B),(A|B) -> 2
+end
+
+module RealCodeTest = struct
+ (* from Alex Fedoseev *)
+
+ type visibility = Shown | Hidden
+
+ type ('outputValue, 'message) fieldStatus =
+ | Pristine
+ | Dirty of ('outputValue, 'message) result * visibility
+
+ type message = string
+
+ type fieldsStatuses = {
+ iaasStorageConfigurations :
+ iaasStorageConfigurationFieldsStatuses array;
+ }
+
+ and iaasStorageConfigurationFieldsStatuses = {
+ startDate : (int, message) fieldStatus;
+ term : (int, message) fieldStatus;
+ rawStorageCapacity : (int, message) fieldStatus;
+ diskType : (string option, message) fieldStatus;
+ connectivityMethod : (string option, message) fieldStatus;
+ getRequest : (int option, message) fieldStatus;
+ getRequestUnit : (string option, message) fieldStatus;
+ putRequest : (int option, message) fieldStatus;
+ putRequestUnit : (string option, message) fieldStatus;
+ transferOut : (int option, message) fieldStatus;
+ transferOutUnit : (string option, message) fieldStatus;
+ region : (string option, message) fieldStatus;
+ cloudType : (string option, message) fieldStatus;
+ description : (string option, message) fieldStatus;
+ features : (string array, message) fieldStatus;
+ accessTypes : (string array, message) fieldStatus;
+ certifications : (string array, message) fieldStatus;
+ additionalRequirements : (string option, message) fieldStatus;
+ }
+
+ type interface = { dirty : unit -> bool }
+
+ let useForm () = {
+ dirty = fun () ->
+ Array.for_all
+ (fun item ->
+ match item with
+ | {
+ additionalRequirements = Pristine;
+ certifications = Pristine;
+ accessTypes = Pristine;
+ features = Pristine;
+ description = Pristine;
+ cloudType = Pristine;
+ region = Pristine;
+ transferOutUnit = Pristine;
+ transferOut = Pristine;
+ putRequestUnit = Pristine;
+ putRequest = Pristine;
+ getRequestUnit = Pristine;
+ getRequest = Pristine;
+ connectivityMethod = Pristine;
+ diskType = Pristine;
+ rawStorageCapacity = Pristine;
+ term = Pristine;
+ startDate = Pristine;
+ } ->
+ false
+ | {
+ additionalRequirements = Pristine | Dirty (_, _);
+ certifications = Pristine | Dirty (_, _);
+ accessTypes = Pristine | Dirty (_, _);
+ features = Pristine | Dirty (_, _);
+ description = Pristine | Dirty (_, _);
+ cloudType = Pristine | Dirty (_, _);
+ region = Pristine | Dirty (_, _);
+ transferOutUnit = Pristine | Dirty (_, _);
+ transferOut = Pristine | Dirty (_, _);
+ putRequestUnit = Pristine | Dirty (_, _);
+ putRequest = Pristine | Dirty (_, _);
+ getRequestUnit = Pristine | Dirty (_, _);
+ getRequest = Pristine | Dirty (_, _);
+ connectivityMethod = Pristine | Dirty (_, _);
+ diskType = Pristine | Dirty (_, _);
+ rawStorageCapacity = Pristine | Dirty (_, _);
+ term = Pristine | Dirty (_, _);
+ startDate = Pristine | Dirty (_, _);
+ } ->
+ true)
+ [||]
+ }
+end
Line 1, characters 33-43:
1 | let () = (let module L = List in raise Exit); () ;;
^^^^^^^^^^
-Warning 21: this statement never returns (or has an unsound type.)
+Warning 21 [nonreturning-statement]: this statement never returns (or has an unsound type.)
Exception: Stdlib.Exit.
|}]
let () = (let exception E in raise Exit); ();;
Line 1, characters 29-39:
1 | let () = (let exception E in raise Exit); ();;
^^^^^^^^^^
-Warning 21: this statement never returns (or has an unsound type.)
+Warning 21 [nonreturning-statement]: this statement never returns (or has an unsound type.)
Exception: Stdlib.Exit.
|}]
let () = (raise Exit : _); ();;
Line 1, characters 10-20:
1 | let () = (raise Exit : _); ();;
^^^^^^^^^^
-Warning 21: this statement never returns (or has an unsound type.)
+Warning 21 [nonreturning-statement]: this statement never returns (or has an unsound type.)
Exception: Stdlib.Exit.
|}]
let () = (let open Stdlib in raise Exit); ();;
Line 1, characters 29-39:
1 | let () = (let open Stdlib in raise Exit); ();;
^^^^^^^^^^
-Warning 21: this statement never returns (or has an unsound type.)
+Warning 21 [nonreturning-statement]: this statement never returns (or has an unsound type.)
Exception: Stdlib.Exit.
|}]
Line 2, characters 20-26:
2 | module M = struct type t end (* unused type t *)
^^^^^^
-Warning 34: unused type t.
+Warning 34 [unused-type-declaration]: unused type t.
Line 3, characters 2-8:
3 | open M (* unused open *)
^^^^^^
-Warning 33: unused open M.
+Warning 33 [unused-open]: unused open M.
module T1 : sig end
|}]
Line 4, characters 2-8:
4 | open M (* used by line below; shadow constructor A *)
^^^^^^
-Warning 45: this open statement shadows the constructor A (which is later used)
+Warning 45 [open-shadow-label-constructor]: this open statement shadows the constructor A (which is later used)
Line 2, characters 2-13:
2 | type t0 = A (* unused type and constructor *)
^^^^^^^^^^^
-Warning 34: unused type t0.
+Warning 34 [unused-type-declaration]: unused type t0.
Line 2, characters 12-13:
2 | type t0 = A (* unused type and constructor *)
^
-Warning 37: unused constructor A.
+Warning 37 [unused-constructor]: unused constructor A.
module T3 : sig end
|}]
Line 3, characters 20-30:
3 | module M = struct type t = A end (* unused type and constructor *)
^^^^^^^^^^
-Warning 34: unused type t.
+Warning 34 [unused-type-declaration]: unused type t.
Line 3, characters 29-30:
3 | module M = struct type t = A end (* unused type and constructor *)
^
-Warning 37: unused constructor A.
+Warning 37 [unused-constructor]: unused constructor A.
Line 4, characters 2-8:
4 | open M (* unused open; no shadowing (A below refers to the one in t0) *)
^^^^^^
-Warning 33: unused open M.
+Warning 33 [unused-open]: unused open M.
module T4 : sig end
|}]
Line 4, characters 2-8:
4 | open M (* shadow constructor A *)
^^^^^^
-Warning 45: this open statement shadows the constructor A (which is later used)
+Warning 45 [open-shadow-label-constructor]: this open statement shadows the constructor A (which is later used)
Line 2, characters 2-13:
2 | type t0 = A (* unused type and constructor *)
^^^^^^^^^^^
-Warning 34: unused type t0.
+Warning 34 [unused-type-declaration]: unused type t0.
Line 2, characters 12-13:
2 | type t0 = A (* unused type and constructor *)
^
-Warning 37: unused constructor A.
+Warning 37 [unused-constructor]: unused constructor A.
module T5 : sig end
|}]
Line 2, characters 20-26:
2 | module M = struct type t end (* unused type t *)
^^^^^^
-Warning 34: unused type t.
+Warning 34 [unused-type-declaration]: unused type t.
Line 3, characters 2-9:
3 | open! M (* unused open *)
^^^^^^^
-Warning 66: unused open! M.
+Warning 66 [unused-open-bang]: unused open! M.
module T1_bis : sig end
|}]
Line 2, characters 2-13:
2 | type t0 = A (* unused type and constructor *)
^^^^^^^^^^^
-Warning 34: unused type t0.
+Warning 34 [unused-type-declaration]: unused type t0.
Line 2, characters 12-13:
2 | type t0 = A (* unused type and constructor *)
^
-Warning 37: unused constructor A.
+Warning 37 [unused-constructor]: unused constructor A.
module T3_bis : sig end
|}]
Line 3, characters 20-30:
3 | module M = struct type t = A end (* unused type and constructor *)
^^^^^^^^^^
-Warning 34: unused type t.
+Warning 34 [unused-type-declaration]: unused type t.
Line 3, characters 29-30:
3 | module M = struct type t = A end (* unused type and constructor *)
^
-Warning 37: unused constructor A.
+Warning 37 [unused-constructor]: unused constructor A.
Line 4, characters 2-9:
4 | open! M (* unused open; no shadowing (A below refers to the one in t0) *)
^^^^^^^
-Warning 66: unused open! M.
+Warning 66 [unused-open-bang]: unused open! M.
module T4_bis : sig end
|}]
Line 2, characters 2-13:
2 | type t0 = A (* unused type and constructor *)
^^^^^^^^^^^
-Warning 34: unused type t0.
+Warning 34 [unused-type-declaration]: unused type t0.
Line 2, characters 12-13:
2 | type t0 = A (* unused type and constructor *)
^
-Warning 37: unused constructor A.
+Warning 37 [unused-constructor]: unused constructor A.
module T5_bis : sig end
|}]
Line 1, characters 31-52:
1 | let f : label choice -> bool = function Left -> true;; (* warn *)
^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
Right
val f : CamlinternalOO.label choice -> bool = <fun>
Line 1, characters 0-1:
1 | A
^
-Warning 41: A belongs to several types: a exn
+Warning 41 [ambiguous-name]: A belongs to several types: a exn
The first one was selected. Please disambiguate if this is wrong.
- : a = A
|}]
Line 1, characters 6-7:
1 | raise A
^
-Warning 42: this use of A relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of A relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
Exception: A.
|}]
Line 1, characters 26-27:
1 | function Not_found -> 1 | A -> 2 | _ -> 3
^
-Warning 42: this use of A relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of A relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
- : exn -> int = <fun>
|}, Principal{|
Line 1, characters 26-27:
1 | function Not_found -> 1 | A -> 2 | _ -> 3
^
-Warning 41: A belongs to several types: a exn
-The first one was selected. Please disambiguate if this is wrong.
+Warning 18 [not-principal]: this type-based constructor disambiguation is not principal.
Line 1, characters 26-27:
1 | function Not_found -> 1 | A -> 2 | _ -> 3
^
-Error: This pattern matches values of type a
- but a pattern was expected which matches values of type exn
+Warning 42 [disambiguated-name]: this use of A relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+- : exn -> int = <fun>
|}]
;;
Line 1, characters 10-11:
1 | try raise A with A -> 2
^
-Warning 42: this use of A relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of A relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
Line 1, characters 17-18:
1 | try raise A with A -> 2
^
-Warning 42: this use of A relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of A relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
- : int = 2
|}]
Line 17, characters 5-35:
17 | match M.is_t () with None -> 0
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
Some (Is Eq)
module Make : functor (M : T) -> sig val f : unit -> int end
Line 2, characters 10-11:
2 | let _f ~x (* x unused argument *) = function
^
-Warning 27: unused variable x.
+Warning 27 [unused-var-strict]: unused variable x.
module X1 : sig end
|}]
Line 2, characters 6-7:
2 | let x = 42 (* unused value *)
^
-Warning 32: unused value x.
+Warning 32 [unused-value-declaration]: unused value x.
module X2 : sig end
|}]
Line 2, characters 24-25:
2 | module O = struct let x = 42 (* unused *) end
^
-Warning 32: unused value x.
+Warning 32 [unused-value-declaration]: unused value x.
Line 3, characters 2-8:
3 | open O (* unused open *)
^^^^^^
-Warning 33: unused open O.
+Warning 33 [unused-open]: unused open O.
module X3 : sig end
|}]
Line 2, characters 35-49:
2 | Foo: 'b * 'b -> foo constraint 'b = [> `Bla ];;
^^^^^^^^^^^^^^
-Warning 62: Type constraints do not apply to GADT cases of variant types.
+Warning 62 [constraint-on-gadt]: Type constraints do not apply to GADT cases of variant types.
type foo = Foo : 'b * 'b -> foo
Line 1, characters 9-19:
1 | let () = raise Exit; () ;; (* warn *)
^^^^^^^^^^
-Warning 21: this statement never returns (or has an unsound type.)
+Warning 21 [nonreturning-statement]: this statement never returns (or has an unsound type.)
Exception: Stdlib.Exit.
|}]
Line 2, characters 2-8:
2 | open A
^^^^^^
-Warning 33: unused open A.
+Warning 33 [unused-open]: unused open A.
module rec C : sig end
|}]
Line 5, characters 10-14:
5 | let None = None
^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
Some _
Line 4, characters 6-12:
4 | open A
^^^^^^
-Warning 33: unused open A.
+Warning 33 [unused-open]: unused open A.
module rec D : sig module M : sig module X : sig end end end
|}]
Line 5, characters 8-9:
5 | let x = 13
^
-Warning 32: unused value x.
+Warning 32 [unused-value-declaration]: unused value x.
module M : sig module F2 : U -> U end
|}]
Line 5, characters 8-9:
5 | let x = 13
^
-Warning 32: unused value x.
+Warning 32 [unused-value-declaration]: unused value x.
module N : sig module F2 : U -> U end
|}]
Line 1, characters 25-31:
1 | module F (X : sig type t type s end) = struct type t = X.t end
^^^^^^
-Warning 34: unused type s.
+Warning 34 [unused-type-declaration]: unused type s.
module F : functor (X : sig type t type s end) -> sig type t = X.t end
|}]
Line 3, characters 19-20:
3 | let f1 (r:t) = r.x (* ok *)
^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
Line 4, characters 29-30:
4 | let f2 r = ignore (r:t); r.x (* non principal *)
^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
Line 7, characters 18-19:
7 | match r with {x; y} -> y + y (* ok *)
^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
Line 7, characters 21-22:
7 | match r with {x; y} -> y + y (* ok *)
^
-Warning 42: this use of y relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of y relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
Line 7, characters 18-19:
7 | match r with {x; y} -> y + y (* ok *)
^
-Warning 27: unused variable x.
+Warning 27 [unused-var-strict]: unused variable x.
module OK :
sig val f1 : M1.t -> int val f2 : M1.t -> int val f3 : M1.t -> int end
|}, Principal{|
Line 3, characters 19-20:
3 | let f1 (r:t) = r.x (* ok *)
^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
Line 4, characters 29-30:
4 | let f2 r = ignore (r:t); r.x (* non principal *)
^
-Warning 18: this type-based field disambiguation is not principal.
+Warning 18 [not-principal]: this type-based field disambiguation is not principal.
Line 4, characters 29-30:
4 | let f2 r = ignore (r:t); r.x (* non principal *)
^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
Line 7, characters 18-19:
7 | match r with {x; y} -> y + y (* ok *)
^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
Line 7, characters 21-22:
7 | match r with {x; y} -> y + y (* ok *)
^
-Warning 42: this use of y relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of y relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
Line 7, characters 18-19:
7 | match r with {x; y} -> y + y (* ok *)
^
-Warning 27: unused variable x.
+Warning 27 [unused-var-strict]: unused variable x.
module OK :
sig val f1 : M1.t -> int val f2 : M1.t -> int val f3 : M1.t -> int end
|}]
Line 3, characters 25-31:
3 | let f r = match r with {x; y} -> y + y
^^^^^^
-Warning 41: these field labels belong to several types: M1.u M1.t
+Warning 41 [ambiguous-name]: these field labels belong to several types: M1.u M1.t
The first one was selected. Please disambiguate if this is wrong.
Line 3, characters 35-36:
3 | let f r = match r with {x; y} -> y + y
Line 6, characters 8-9:
6 | {x; y} -> y + y
^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
Line 6, characters 11-12:
6 | {x; y} -> y + y
^
-Warning 42: this use of y relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of y relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
Line 6, characters 8-9:
6 | {x; y} -> y + y
^
-Warning 27: unused variable x.
+Warning 27 [unused-var-strict]: unused variable x.
module F2 : sig val f : M1.t -> int end
|}, Principal{|
-Line 6, characters 7-13:
+Line 6, characters 8-9:
6 | {x; y} -> y + y
- ^^^^^^
-Warning 41: these field labels belong to several types: M1.u M1.t
-The first one was selected. Please disambiguate if this is wrong.
+ ^
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+Line 6, characters 11-12:
+6 | {x; y} -> y + y
+ ^
+Warning 42 [disambiguated-name]: this use of y relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
Line 6, characters 7-13:
6 | {x; y} -> y + y
^^^^^^
-Error: This pattern matches values of type M1.u
- but a pattern was expected which matches values of type M1.t
+Warning 18 [not-principal]: this type-based record disambiguation is not principal.
+Line 6, characters 8-9:
+6 | {x; y} -> y + y
+ ^
+Warning 27 [unused-var-strict]: unused variable x.
+module F2 : sig val f : M1.t -> int end
|}]
(* Use type information with modules*)
Line 1, characters 18-21:
1 | let f (r:M.t) = r.M.x;; (* ok *)
^^^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
val f : M.t -> int = <fun>
|}]
Line 1, characters 18-19:
1 | let f (r:M.t) = r.x;; (* warning *)
^
-Warning 40: x was selected from type M.t.
+Warning 40 [name-out-of-scope]: x was selected from type M.t.
It is not visible in the current scope, and will not
be selected if the type becomes unknown.
Line 1, characters 18-19:
1 | let f (r:M.t) = r.x;; (* warning *)
^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
val f : M.t -> int = <fun>
|}]
Line 1, characters 8-9:
1 | let f ({x}:M.t) = x;; (* warning *)
^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
Line 1, characters 7-10:
1 | let f ({x}:M.t) = x;; (* warning *)
^^^
-Warning 40: this record of type M.t contains fields that are
+Warning 40 [name-out-of-scope]: this record of type M.t contains fields that are
not visible in the current scope: x.
They will not be selected if the type becomes unknown.
val f : M.t -> int = <fun>
Line 4, characters 20-21:
4 | let f (r:M.t) = r.x
^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
Line 3, characters 2-8:
3 | open N
^^^^^^
-Warning 33: unused open N.
+Warning 33 [unused-open]: unused open N.
module OK : sig val f : M.t -> int end
|}]
Line 3, characters 9-10:
3 | let f {x;z} = x,z
^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
Line 3, characters 8-13:
3 | let f {x;z} = x,z
^^^^^
-Warning 9: the following labels are not bound in this record pattern:
+Warning 9 [missing-record-field-pattern]: the following labels are not bound in this record pattern:
y
Either bind these labels explicitly or add '; _' to the pattern.
module OK : sig val f : M.u -> bool * char end
Line 3, characters 11-12:
3 | let r = {x=true;z='z'}
^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
Line 3, characters 10-24:
3 | let r = {x=true;z='z'}
Line 4, characters 11-12:
4 | let r = {x=3; y=true}
^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
Line 4, characters 16-17:
4 | let r = {x=3; y=true}
^
-Warning 42: this use of y relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of y relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
module OK :
sig
Line 1, characters 8-28:
1 | let r = {MN.x = 3; NM.y = 4};; (* error: type would change with order *)
^^^^^^^^^^^^^^^^^^^^
-Warning 41: x belongs to several types: MN.bar MN.foo
+Warning 41 [ambiguous-name]: x belongs to several types: MN.bar MN.foo
The first one was selected. Please disambiguate if this is wrong.
Line 1, characters 8-28:
1 | let r = {MN.x = 3; NM.y = 4};; (* error: type would change with order *)
^^^^^^^^^^^^^^^^^^^^
-Warning 41: y belongs to several types: NM.foo NM.bar
+Warning 41 [ambiguous-name]: y belongs to several types: NM.foo NM.bar
The first one was selected. Please disambiguate if this is wrong.
Line 1, characters 19-23:
1 | let r = {MN.x = 3; NM.y = 4};; (* error: type would change with order *)
Line 3, characters 37-38:
3 | let f r = ignore (r: foo); {r with x = 2; z = 3}
^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
Line 3, characters 44-45:
3 | let f r = ignore (r: foo); {r with x = 2; z = 3}
Line 3, characters 38-39:
3 | let f r = ignore (r: foo); { r with x = 3; a = 4 }
^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
Line 3, characters 45-46:
3 | let f r = ignore (r: foo); { r with x = 3; a = 4 }
Line 3, characters 11-12:
3 | let r = {x=1; y=2}
^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
Line 3, characters 16-17:
3 | let r = {x=1; y=2}
^
-Warning 42: this use of y relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of y relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
Line 4, characters 18-19:
4 | let r: other = {x=1; y=2}
Line 1, characters 12-13:
1 | class g = f A;; (* ok *)
^
-Warning 42: this use of A relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of A relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
class g : f
class f : 'a -> 'a -> object end
Line 1, characters 13-14:
1 | class g = f (A : t) A;; (* warn with -principal *)
^
-Warning 42: this use of A relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of A relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
Line 1, characters 20-21:
1 | class g = f (A : t) A;; (* warn with -principal *)
^
-Warning 42: this use of A relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of A relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
class g : f
|}, Principal{|
Line 1, characters 13-14:
1 | class g = f (A : t) A;; (* warn with -principal *)
^
-Warning 42: this use of A relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of A relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
Line 1, characters 20-21:
1 | class g = f (A : t) A;; (* warn with -principal *)
^
-Warning 18: this type-based constructor disambiguation is not principal.
+Warning 18 [not-principal]: this type-based constructor disambiguation is not principal.
Line 1, characters 20-21:
1 | class g = f (A : t) A;; (* warn with -principal *)
^
-Warning 42: this use of A relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of A relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
class g : f
|}]
Line 7, characters 15-16:
7 | let y : t = {x = 0}
^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
Line 6, characters 2-8:
6 | open M (* this open is unused, it isn't reported as shadowing 'x' *)
^^^^^^
-Warning 33: unused open M.
+Warning 33 [unused-open]: unused open M.
module Shadow1 :
sig
type t = { x : int; }
Line 6, characters 2-8:
6 | open M (* this open shadows label 'x' *)
^^^^^^
-Warning 45: this open statement shadows the label x (which is later used)
+Warning 45 [open-shadow-label-constructor]: this open statement shadows the label x (which is later used)
Line 7, characters 10-18:
7 | let y = {x = ""}
^^^^^^^^
-Warning 41: these field labels belong to several types: M.s t
+Warning 41 [ambiguous-name]: these field labels belong to several types: M.s t
The first one was selected. Please disambiguate if this is wrong.
module Shadow2 :
sig
Line 5, characters 37-40:
5 | let f (u : u) = match u with `Key {loc} -> loc
^^^
-Warning 42: this use of loc relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of loc relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
module P6235 :
sig
Line 7, characters 11-14:
7 | |`Key {loc} -> loc
^^^
-Warning 42: this use of loc relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of loc relies on type-directed disambiguation,
it will not compile with OCaml 4.00 or earlier.
module P6235' :
sig
val f : u -> string
end
|}, Principal{|
-Line 7, characters 10-15:
+Line 7, characters 11-14:
7 | |`Key {loc} -> loc
- ^^^^^
-Warning 41: these field labels belong to several types: v t
-The first one was selected. Please disambiguate if this is wrong.
+ ^^^
+Warning 42 [disambiguated-name]: this use of loc relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
Line 7, characters 10-15:
7 | |`Key {loc} -> loc
^^^^^
-Warning 9: the following labels are not bound in this record pattern:
-x
-Either bind these labels explicitly or add '; _' to the pattern.
-Line 7, characters 5-15:
-7 | |`Key {loc} -> loc
- ^^^^^^^^^^
-Error: This pattern matches values of type [? `Key of v ]
- but a pattern was expected which matches values of type u
- Types for tag `Key are incompatible
+Warning 18 [not-principal]: this type-based record disambiguation is not principal.
+module P6235' :
+ sig
+ type t = { loc : string; }
+ type v = { loc : string; x : int; }
+ type u = [ `Key of t ]
+ val f : u -> string
+ end
|}]
(** no candidates after filtering;
Error: The field M.x belongs to the record type M.t
but a field was expected belonging to the record type u
|}]
+
+(* PR#8747 *)
+module M = struct type t = { x : int; y: char } end
+let f (x : M.t) = { x with y = 'a' }
+let g (x : M.t) = { x with y = 'a' } :: []
+let h (x : M.t) = { x with y = 'a' } :: { x with y = 'b' } :: [];;
+[%%expect{|
+module M : sig type t = { x : int; y : char; } end
+Line 2, characters 27-28:
+2 | let f (x : M.t) = { x with y = 'a' }
+ ^
+Warning 42 [disambiguated-name]: this use of y relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+Line 2, characters 18-36:
+2 | let f (x : M.t) = { x with y = 'a' }
+ ^^^^^^^^^^^^^^^^^^
+Warning 40 [name-out-of-scope]: this record of type M.t contains fields that are
+not visible in the current scope: y.
+They will not be selected if the type becomes unknown.
+val f : M.t -> M.t = <fun>
+Line 3, characters 27-28:
+3 | let g (x : M.t) = { x with y = 'a' } :: []
+ ^
+Warning 42 [disambiguated-name]: this use of y relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+Line 3, characters 18-36:
+3 | let g (x : M.t) = { x with y = 'a' } :: []
+ ^^^^^^^^^^^^^^^^^^
+Warning 40 [name-out-of-scope]: this record of type M.t contains fields that are
+not visible in the current scope: y.
+They will not be selected if the type becomes unknown.
+val g : M.t -> M.t list = <fun>
+Line 4, characters 27-28:
+4 | let h (x : M.t) = { x with y = 'a' } :: { x with y = 'b' } :: [];;
+ ^
+Warning 42 [disambiguated-name]: this use of y relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+Line 4, characters 18-36:
+4 | let h (x : M.t) = { x with y = 'a' } :: { x with y = 'b' } :: [];;
+ ^^^^^^^^^^^^^^^^^^
+Warning 40 [name-out-of-scope]: this record of type M.t contains fields that are
+not visible in the current scope: y.
+They will not be selected if the type becomes unknown.
+Line 4, characters 49-50:
+4 | let h (x : M.t) = { x with y = 'a' } :: { x with y = 'b' } :: [];;
+ ^
+Warning 42 [disambiguated-name]: this use of y relies on type-directed disambiguation,
+it will not compile with OCaml 4.00 or earlier.
+Line 4, characters 40-58:
+4 | let h (x : M.t) = { x with y = 'a' } :: { x with y = 'b' } :: [];;
+ ^^^^^^^^^^^^^^^^^^
+Warning 40 [name-out-of-scope]: this record of type M.t contains fields that are
+not visible in the current scope: y.
+They will not be selected if the type becomes unknown.
+val h : M.t -> M.t list = <fun>
+|}]
Line 1, characters 11-17:
1 | module Foo(Unused : sig end) = struct end;;
^^^^^^
-Warning 60: unused module Unused.
+Warning 60 [unused-module]: unused module Unused.
module Foo : functor (Unused : sig end) -> sig end
|}]
Line 1, characters 25-31:
1 | module type S = functor (Unused : sig end) -> sig end;;
^^^^^^
-Warning 67: unused functor parameter Unused.
+Warning 67 [unused-functor-parameter]: unused functor parameter Unused.
module type S = functor (Unused : sig end) -> sig end
|}]
Line 2, characters 12-18:
2 | module M (Unused : sig end) : sig end
^^^^^^
-Warning 67: unused functor parameter Unused.
+Warning 67 [unused-functor-parameter]: unused functor parameter Unused.
module type S = sig module M : functor (Unused : sig end) -> sig end end
|}]
Line 3, characters 8-9:
3 | let rec f () = 3;;
^
-Warning 39: unused rec flag.
+Warning 39 [unused-rec-flag]: unused rec flag.
val f : unit -> int = <fun>
|}];;
Line 1, characters 24-25:
1 | let[@warning "+39"] rec h () = 3;;
^
-Warning 39: unused rec flag.
+Warning 39 [unused-rec-flag]: unused rec flag.
val h : unit -> int = <fun>
|}];;
Line 1, characters 24-25:
1 | let[@warning "+39"] rec h () = 3;;
^
-Warning 39: unused rec flag.
+Warning 39 [unused-rec-flag]: unused rec flag.
val h : unit -> int = <fun>
|}];;
Line 14, characters 4-10:
14 | type t
^^^^^^
-Warning 34: unused type t.
+Warning 34 [unused-type-declaration]: unused type t.
module M : sig end
|}];;
Line 3, characters 2-19:
3 | type unused = int
^^^^^^^^^^^^^^^^^
-Warning 34: unused type unused.
+Warning 34 [unused-type-declaration]: unused type unused.
module Unused : sig end
|}]
Line 4, characters 2-27:
4 | type nonrec unused = used
^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 34: unused type unused.
+Warning 34 [unused-type-declaration]: unused type unused.
module Unused_nonrec : sig end
|}]
Line 3, characters 2-27:
3 | type unused = A of unused
^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 34: unused type unused.
+Warning 34 [unused-type-declaration]: unused type unused.
Line 3, characters 16-27:
3 | type unused = A of unused
^^^^^^^^^^^
-Warning 37: unused constructor A.
+Warning 37 [unused-constructor]: unused constructor A.
module Unused_rec : sig end
|}]
Line 4, characters 11-12:
4 | type t = T
^
-Warning 37: unused constructor T.
+Warning 37 [unused-constructor]: unused constructor T.
module Unused_constructor : sig type t end
|}]
Line 5, characters 11-12:
5 | type t = T
^
-Warning 37: constructor T is never used to build values.
+Warning 37 [unused-constructor]: constructor T is never used to build values.
(However, this constructor appears in patterns.)
module Unused_constructor_outside_patterns :
sig type t val nothing : t -> unit end
Line 4, characters 11-12:
4 | type t = T
^
-Warning 37: constructor T is never used to build values.
+Warning 37 [unused-constructor]: constructor T is never used to build values.
Its type is exported as a private type.
module Unused_constructor_exported_private : sig type t = private T end
|}]
Line 4, characters 19-20:
4 | type t = private T
^
-Warning 37: unused constructor T.
+Warning 37 [unused-constructor]: unused constructor T.
module Unused_private_constructor : sig type t end
|}]
Line 3, characters 2-26:
3 | exception Nobody_uses_me
^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 38: unused exception Nobody_uses_me
+Warning 38 [unused-extension]: unused exception Nobody_uses_me
module Unused_exception : sig end
|}]
Line 5, characters 12-26:
5 | type t += Nobody_uses_me
^^^^^^^^^^^^^^
-Warning 38: unused extension constructor Nobody_uses_me
+Warning 38 [unused-extension]: unused extension constructor Nobody_uses_me
module Unused_extension_constructor : sig type t = .. end
|}]
Line 4, characters 2-32:
4 | exception Nobody_constructs_me
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 38: exception Nobody_constructs_me is never used to build values.
+Warning 38 [unused-extension]: exception Nobody_constructs_me is never used to build values.
(However, this constructor appears in patterns.)
module Unused_exception_outside_patterns : sig val falsity : exn -> bool end
|}]
Line 6, characters 12-27:
6 | type t += Noone_builds_me
^^^^^^^^^^^^^^^
-Warning 38: extension constructor Noone_builds_me is never used to build values.
+Warning 38 [unused-extension]: extension constructor Noone_builds_me is never used to build values.
(However, this constructor appears in patterns.)
module Unused_extension_outside_patterns :
sig type t = .. val falsity : t -> bool end
Line 4, characters 2-23:
4 | exception Private_exn
^^^^^^^^^^^^^^^^^^^^^
-Warning 38: exception Private_exn is never used to build values.
+Warning 38 [unused-extension]: exception Private_exn is never used to build values.
It is exported or rebound as a private extension.
module Unused_exception_exported_private :
sig type exn += private Private_exn end
Line 6, characters 12-23:
6 | type t += Private_ext
^^^^^^^^^^^
-Warning 38: extension constructor Private_ext is never used to build values.
+Warning 38 [unused-extension]: extension constructor Private_ext is never used to build values.
It is exported or rebound as a private extension.
module Unused_extension_exported_private :
sig type t = .. type t += private Private_ext end
Line 5, characters 20-31:
5 | type t += private Private_ext
^^^^^^^^^^^
-Warning 38: unused extension constructor Private_ext
+Warning 38 [unused-extension]: unused extension constructor Private_ext
module Unused_private_extension : sig type t end
|}]
Line 3, characters 11-12:
3 | type t = A [@@warning "-34"]
^
-Warning 37: unused constructor A.
+Warning 37 [unused-constructor]: unused constructor A.
module Unused_type_disable_warning : sig end
|}]
Line 3, characters 2-30:
3 | type t = A [@@warning "-37"]
^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 34: unused type t.
+Warning 34 [unused-type-declaration]: unused type t.
module Unused_constructor_disable_warning : sig end
|}]
--- /dev/null
+(* TEST
+ * expect
+*)
+let foo ?x = ()
+[%%expect{|
+Line 1, characters 9-10:
+1 | let foo ?x = ()
+ ^
+Warning 16 [unerasable-optional-argument]: this optional argument cannot be erased.
+val foo : ?x:'a -> unit = <fun>
+|}]
+
+let foo ?x ~y = ()
+[%%expect{|
+Line 1, characters 9-10:
+1 | let foo ?x ~y = ()
+ ^
+Warning 16 [unerasable-optional-argument]: this optional argument cannot be erased.
+val foo : ?x:'a -> y:'b -> unit = <fun>
+|}]
+
+let foo ?x () = ()
+[%%expect{|
+val foo : ?x:'a -> unit -> unit = <fun>
+|}]
+
+let foo ?x ~y () = ()
+[%%expect{|
+val foo : ?x:'a -> y:'b -> unit -> unit = <fun>
+|}]
+
+class bar ?x = object end
+[%%expect{|
+Line 1, characters 11-12:
+1 | class bar ?x = object end
+ ^
+Warning 16 [unerasable-optional-argument]: this optional argument cannot be erased.
+class bar : ?x:'a -> object end
+|}]
+
+class bar ?x ~y = object end
+[%%expect{|
+Line 1, characters 11-12:
+1 | class bar ?x ~y = object end
+ ^
+Warning 16 [unerasable-optional-argument]: this optional argument cannot be erased.
+class bar : ?x:'a -> y:'b -> object end
+|}]
+
+class bar ?x () = object end
+[%%expect{|
+class bar : ?x:'a -> unit -> object end
+|}]
+
+class foo ?x ~y () = object end
+[%%expect{|
+class foo : ?x:'a -> y:'b -> unit -> object end
+|}]
(* TEST
-* hasunix
-include unix
-
files = "common.mli common.ml test_common.c test_common.h"
-** setup-ocamlopt.byte-build-env
-*** ocaml
+* setup-ocamlopt.byte-build-env
+** ocaml
test_file = "${test_source_directory}/gen_test.ml"
ocaml_script_as_argument = "true"
arguments = "c"
compiler_output = "stubs.c"
-**** ocaml
+*** ocaml
arguments = "ml"
compiler_output = "main.ml"
-***** ocamlopt.byte
+**** ocamlopt.byte
all_modules = "test_common.c stubs.c common.mli common.ml main.ml"
-****** run
-******* check-program-output
+***** run
+****** check-program-output
*)
files = "mylib.mli mylib.ml stack_walker.c"
* macos
-** script
-*** setup-ocamlopt.byte-build-env
-**** ocamlopt.byte
+** arch_amd64
+*** script
+**** setup-ocamlopt.byte-build-env
+***** ocamlopt.byte
flags = "-opaque"
module = "mylib.mli"
-***** ocamlopt.byte
+****** ocamlopt.byte
module = ""
flags = "-cclib -Wl,-keep_dwarf_unwind"
all_modules = "mylib.ml driver.ml stack_walker.c"
program = "${test_build_directory}/unwind_test"
-****** run
+******* run
*)
return Val_unit;
}
-void error() {
- exit(1);
-}
-
-void perform_stack_walk() {
+int perform_stack_walk(int dbg) {
unw_context_t ctxt;
unw_getcontext(&ctxt);
unw_cursor_t cursor;
{
int result = unw_init_local(&cursor, &ctxt);
- if (result != 0) error();
+ if (result != 0) {
+ if (dbg) printf("unw_init_local failed: %d\n", result);
+ return -1;
+ }
}
int reached_main = 0;
unw_word_t ip_offset; // IP - start_of_proc
int result = unw_get_proc_name(&cursor, procname, sizeof(procname),
&ip_offset);
- if (result != 0) error();
+ if (result != 0) {
+ if (dbg) printf("unw_get_proc_name failed: %d\n", result);
+ return -1;
+ }
+
if (strcmp(procname, "main") == 0)
reached_main = 1;
- //printf("%s + %lld\n", procname, (long long int)ip_offset);
+ if (dbg) printf("%s + %lld\n", procname, (long long int)ip_offset);
}
{
int result = unw_step(&cursor);
if (result == 0) break;
- if (result < 0) error();
+ if (result < 0) {
+ if (dbg) printf("unw_step failed: %d\n", result);
+ return -1;
+ }
}
}
- //printf("Reached end of stack.\n");
+ if (dbg) printf("Reached end of stack.\n");
if (!reached_main) {
- //printf("Failure: Did not reach main.\n");
- error();
+ if (dbg) printf("Failure: Did not reach main.\n");
+ return -1;
}
+ return 0;
}
value ml_perform_stack_walk() {
- perform_stack_walk();
+ if (perform_stack_walk(0) != 0) {
+ printf("TEST FAILED\n");
+ /* Re-run the test to produce a trace */
+ perform_stack_walk(1);
+ exit(1);
+ }
return Val_unit;
}
--- /dev/null
+(* TEST
+
+ocamllex_flags = "-q"
+
+*)
+
+{
+}
+
+let ws = [' ''\t']
+let nl = '\n'
+let constr = ['A'-'Z']['a'-'z''A'-'Z''0'-'9''_']*
+let int = ['0'-'9']+
+let mnemo = ['a'-'z']['a'-'z''-']*['a'-'z']
+
+rule seek_let_number_function = parse
+| ws* "let" ws+ "number" ws* "=" ws* "function" ws* '\n'
+ { () }
+| [^'\n']* '\n'
+ { seek_let_number_function lexbuf }
+
+and constructors = parse
+| ws* '|' ws* (constr as c) (ws* '_')? ws* "->" ws* (int as n) [^'\n']* '\n'
+ { (c, int_of_string n) :: constructors lexbuf }
+| ws* ";;" ws* '\n'
+ { [] }
+
+and mnemonics = parse
+| ws* (int as n) ws+ '[' (mnemo as s) ']' [^'\n']* '\n'
+ { (s, int_of_string n) :: mnemonics lexbuf }
+| [^'\n']* '\n'
+ { mnemonics lexbuf }
+| eof
+ { [] }
+
+{
+let ocamlsrcdir = Sys.getenv "ocamlsrcdir"
+
+let ocamlrun = Sys.getenv "ocamlrun"
+
+let constructors =
+ let ic = open_in Filename.(concat ocamlsrcdir (concat "utils" "warnings.ml")) in
+ Fun.protect ~finally:(fun () -> close_in_noerr ic)
+ (fun () ->
+ let lexbuf = Lexing.from_channel ic in
+ seek_let_number_function lexbuf;
+ constructors lexbuf
+ )
+
+let mnemonics =
+ let stdout = "warn-help.out" in
+ let n =
+ Sys.command
+ Filename.(quote_command ~stdout
+ ocamlrun [concat ocamlsrcdir "ocamlc"; "-warn-help"])
+ in
+ assert (n = 0);
+ let ic = open_in stdout in
+ Fun.protect ~finally:(fun () -> close_in_noerr ic)
+ (fun () ->
+ let lexbuf = Lexing.from_channel ic in
+ mnemonics lexbuf
+ )
+
+let mnemonic_of_constructor s =
+ String.map (function '_' -> '-' | c -> Char.lowercase_ascii c) s
+
+let () =
+ List.iter (fun (s, n) ->
+ let f (c, m) = mnemonic_of_constructor c = s && n = m in
+ if not (List.exists f constructors) then
+ Printf.printf "Could not find constructor corresponding to mnemonic %S (%d)\n%!" s n
+ ) mnemonics
+
+let _ =
+ List.fold_left (fun first (c, m) ->
+ if List.mem (mnemonic_of_constructor c, m) mnemonics then first
+ else begin
+ if first then print_endline "Constructors without associated mnemonic:";
+ print_endline c;
+ false
+ end
+ ) true constructors
+}
--- /dev/null
+Constructors without associated mnemonic:
+All_clauses_guarded
File "w01.ml", line 14, characters 12-14:
14 | let foo = ( *);;
^^
-Warning 2: this is not the end of a comment.
+Warning 2 [comment-not-end]: this is not the end of a comment.
File "w01.ml", line 20, characters 0-3:
20 | f 1; f 1;;
^^^
-Warning 5: this function application is partial,
+Warning 5 [ignored-partial-application]: this function application is partial,
maybe some arguments are missing.
File "w01.ml", line 30, characters 4-5:
30 | let 1 = 1;;
^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
0
File "w01.ml", line 35, characters 0-1:
35 | 1; 1;;
^
-Warning 10: this expression should have type unit.
+Warning 10 [non-unit-statement]: this expression should have type unit.
File "w01.ml", line 42, characters 2-3:
42 | | 1 -> ()
^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
File "w01.ml", line 19, characters 8-9:
19 | let f x y = x;;
^
-Warning 27: unused variable y.
+Warning 27 [unused-var-strict]: unused variable y.
File "w03.ml", line 17, characters 12-26:
17 | exception B [@@deprecated]
^^^^^^^^^^^^^^
-Warning 53: the "deprecated" attribute cannot appear in this context
+Warning 53 [misplaced-attribute]: the "deprecated" attribute cannot appear in this context
21 | ..........match x with
22 | | A -> 0
23 | | _ -> 1
-Warning 4: this pattern-matching is fragile.
+Warning 4 [fragile-match]: this pattern-matching is fragile.
It will remain exhaustive when constructors are added to type t.
21 | | AB, _, A -> ()
22 | | _, XY, X -> ()
23 | | _, _, _ -> ()
-Warning 4: this pattern-matching is fragile.
+Warning 4 [fragile-match]: this pattern-matching is fragile.
It will remain exhaustive when constructors are added to type repr.
File "w04_failure.ml", lines 20-23, characters 2-17:
20 | ..match r1, r2, t with
21 | | AB, _, A -> ()
22 | | _, XY, X -> ()
23 | | _, _, _ -> ()
-Warning 4: this pattern-matching is fragile.
+Warning 4 [fragile-match]: this pattern-matching is fragile.
It will remain exhaustive when constructors are added to type ab.
File "w04_failure.ml", lines 20-23, characters 2-17:
20 | ..match r1, r2, t with
21 | | AB, _, A -> ()
22 | | _, XY, X -> ()
23 | | _, _, _ -> ()
-Warning 4: this pattern-matching is fragile.
+Warning 4 [fragile-match]: this pattern-matching is fragile.
It will remain exhaustive when constructors are added to type xy.
File "w06.ml", line 16, characters 9-12:
16 | let () = foo 2
^^^
-Warning 6: label bar was omitted in the application of this function.
+Warning 6 [labels-omitted]: label bar was omitted in the application of this function.
File "w06.ml", line 17, characters 9-12:
17 | let () = bar 4 2
^^^
-Warning 6: labels foo, baz were omitted in the application of this function.
+Warning 6 [labels-omitted]: labels foo, baz were omitted in the application of this function.
File "w32.mli", line 12, characters 10-11:
12 | module F (X : sig val x : int end) : sig end
^
-Warning 67: unused functor parameter X.
+Warning 67 [unused-functor-parameter]: unused functor parameter X.
File "w32.mli", line 14, characters 10-11:
14 | module G (X : sig val x : int end) : sig end
^
-Warning 67: unused functor parameter X.
+Warning 67 [unused-functor-parameter]: unused functor parameter X.
File "w32.mli", line 16, characters 10-11:
16 | module H (X : sig val x : int end) : sig val x : int end
^
-Warning 67: unused functor parameter X.
+Warning 67 [unused-functor-parameter]: unused functor parameter X.
File "w32.ml", line 40, characters 24-25:
40 | let[@warning "-32"] rec q x = x
^
-Warning 39: unused rec flag.
+Warning 39 [unused-rec-flag]: unused rec flag.
File "w32.ml", line 43, characters 24-25:
43 | let[@warning "-32"] rec s x = x
^
-Warning 39: unused rec flag.
+Warning 39 [unused-rec-flag]: unused rec flag.
File "w32.ml", line 20, characters 4-5:
20 | let h x = x
^
-Warning 32: unused value h.
+Warning 32 [unused-value-declaration]: unused value h.
File "w32.ml", line 26, characters 4-5:
26 | and j x = x
^
-Warning 32: unused value j.
+Warning 32 [unused-value-declaration]: unused value j.
File "w32.ml", line 28, characters 4-5:
28 | let k x = x
^
-Warning 32: unused value k.
+Warning 32 [unused-value-declaration]: unused value k.
File "w32.ml", line 41, characters 4-5:
41 | and r x = x
^
-Warning 32: unused value r.
+Warning 32 [unused-value-declaration]: unused value r.
File "w32.ml", line 44, characters 20-21:
44 | and[@warning "-39"] t x = x
^
-Warning 32: unused value t.
+Warning 32 [unused-value-declaration]: unused value t.
File "w32.ml", line 46, characters 24-25:
46 | let[@warning "-39"] rec u x = x
^
-Warning 32: unused value u.
+Warning 32 [unused-value-declaration]: unused value u.
File "w32.ml", line 47, characters 4-5:
47 | and v x = v x
^
-Warning 32: unused value v.
+Warning 32 [unused-value-declaration]: unused value v.
File "w32.ml", line 55, characters 22-23:
55 | let[@warning "+32"] g x = x
^
-Warning 32: unused value g.
+Warning 32 [unused-value-declaration]: unused value g.
File "w32.ml", line 56, characters 22-23:
56 | let[@warning "+32"] h x = x
^
-Warning 32: unused value h.
+Warning 32 [unused-value-declaration]: unused value h.
File "w32.ml", line 59, characters 22-23:
59 | and[@warning "+32"] k x = x
^
-Warning 32: unused value k.
+Warning 32 [unused-value-declaration]: unused value k.
File "w32.ml", lines 52-60, characters 0-3:
52 | module M = struct
53 | [@@@warning "-32"]
58 | let j x = x
59 | and[@warning "+32"] k x = x
60 | end
-Warning 60: unused module M.
+Warning 60 [unused-module]: unused module M.
File "w32.ml", line 63, characters 18-29:
63 | module F (X : sig val x : int end) = struct end
^^^^^^^^^^^
-Warning 32: unused value x.
+Warning 32 [unused-value-declaration]: unused value x.
File "w32.ml", line 63, characters 10-11:
63 | module F (X : sig val x : int end) = struct end
^
-Warning 60: unused module X.
+Warning 60 [unused-module]: unused module X.
File "w32.ml", line 65, characters 18-29:
65 | module G (X : sig val x : int end) = X
^^^^^^^^^^^
-Warning 32: unused value x.
+Warning 32 [unused-value-declaration]: unused value x.
File "w32b.ml", line 13, characters 18-24:
13 | module Q (M : sig type t end) = struct end
^^^^^^
-Warning 34: unused type t.
+Warning 34 [unused-type-declaration]: unused type t.
File "w32b.ml", line 13, characters 10-11:
13 | module Q (M : sig type t end) = struct end
^
-Warning 60: unused module M.
+Warning 60 [unused-module]: unused module M.
File "w33.ml", line 19, characters 6-11:
19 | let f M.(x) = x (* useless open *)
^^^^^
-Warning 33: unused open M.
+Warning 33 [unused-open]: unused open M.
File "w33.ml", line 26, characters 0-7:
26 | open! M (* useless open! *)
^^^^^^^
-Warning 66: unused open! M.
+Warning 66 [unused-open-bang]: unused open! M.
File "w33.ml", line 27, characters 0-6:
27 | open M (* useless open *)
^^^^^^
-Warning 33: unused open M.
+Warning 33 [unused-open]: unused open M.
File "w45.ml", line 24, characters 2-9:
24 | open T2 (* shadow X, which is later used; but not A, see #6762 *)
^^^^^^^
-Warning 45: this open statement shadows the constructor X (which is later used)
+Warning 45 [open-shadow-label-constructor]: this open statement shadows the constructor X (which is later used)
File "w45.ml", line 26, characters 14-15:
26 | let _ = (A, X) (* X belongs to several types *)
^
-Warning 41: X belongs to several types: T2.s T1.s
+Warning 41 [ambiguous-name]: X belongs to several types: T2.s T1.s
The first one was selected. Please disambiguate if this is wrong.
File "w45.ml", line 23, characters 2-9:
23 | open T1 (* unused open *)
^^^^^^^
-Warning 33: unused open T1.
+Warning 33 [unused-open]: unused open T1.
File "w47_inline.ml", line 30, characters 20-22:
30 | let[@local never] f2 x = x (* ok *) in
^^
-Warning 26: unused variable f2.
+Warning 26 [unused-var]: unused variable f2.
File "w47_inline.ml", line 31, characters 24-26:
31 | let[@local malformed] f3 x = x (* bad payload *) in
^^
-Warning 26: unused variable f3.
+Warning 26 [unused-var]: unused variable f3.
File "w47_inline.ml", line 15, characters 23-29:
15 | let d = (fun x -> x) [@inline malformed attribute] (* rejected *)
^^^^^^
-Warning 47: illegal payload for attribute 'inline'.
+Warning 47 [attribute-payload]: illegal payload for attribute 'inline'.
It must be either 'never', 'always', 'hint' or empty
File "w47_inline.ml", line 16, characters 23-29:
16 | let e = (fun x -> x) [@inline malformed_attribute] (* rejected *)
^^^^^^
-Warning 47: illegal payload for attribute 'inline'.
+Warning 47 [attribute-payload]: illegal payload for attribute 'inline'.
It must be either 'never', 'always', 'hint' or empty
File "w47_inline.ml", line 17, characters 23-29:
17 | let f = (fun x -> x) [@inline : malformed_attribute] (* rejected *)
^^^^^^
-Warning 47: illegal payload for attribute 'inline'.
+Warning 47 [attribute-payload]: illegal payload for attribute 'inline'.
It must be either 'never', 'always', 'hint' or empty
File "w47_inline.ml", line 18, characters 23-29:
18 | let g = (fun x -> x) [@inline ? malformed_attribute] (* rejected *)
^^^^^^
-Warning 47: illegal payload for attribute 'inline'.
+Warning 47 [attribute-payload]: illegal payload for attribute 'inline'.
It must be either 'never', 'always', 'hint' or empty
File "w47_inline.ml", line 23, characters 15-22:
23 | let k x = (a [@inlined malformed]) x (* rejected *)
^^^^^^^
-Warning 47: illegal payload for attribute 'inlined'.
+Warning 47 [attribute-payload]: illegal payload for attribute 'inlined'.
It must be either 'never', 'always', 'hint' or empty
File "w47_inline.ml", line 31, characters 7-12:
31 | let[@local malformed] f3 x = x (* bad payload *) in
^^^^^
-Warning 47: illegal payload for attribute 'local'.
+Warning 47 [attribute-payload]: illegal payload for attribute 'local'.
It must be either 'never', 'always', 'maybe' or empty
File "w47_inline.ml", line 32, characters 17-26:
32 | let[@local] f4 x = 2 * x (* not local *) in
^^^^^^^^^
-Warning 55: Cannot inline: This function cannot be compiled into a static continuation
+Warning 55 [inlining-impossible]: Cannot inline: This function cannot be compiled into a static continuation
File "w50.ml", line 13, characters 2-17:
13 | module L = List
^^^^^^^^^^^^^^^
-Warning 60: unused module L.
+Warning 60 [unused-module]: unused module L.
File "w50.ml", line 17, characters 2-16:
17 | module Y1 = X1
^^^^^^^^^^^^^^
-Warning 60: unused module Y1.
+Warning 60 [unused-module]: unused module Y1.
+++ /dev/null
-File "w51.ml", line 14, characters 13-37:
-14 | | n -> n * (fact [@tailcall]) (n-1)
- ^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 51: expected tailcall
(* TEST
-
-flags = "-w A"
-
-* setup-ocamlc.byte-build-env
-** ocamlc.byte
-compile_only = "true"
-*** check-ocamlc.byte-output
-
+ flags = "-w A"
+ * expect
*)
let rec fact = function
| 1 -> 1
| n -> n * (fact [@tailcall]) (n-1)
;;
+[%%expect {|
+Line 3, characters 13-37:
+3 | | n -> n * (fact [@tailcall]) (n-1)
+ ^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 51 [wrong-tailcall-expectation]: expected tailcall
+val fact : int -> int = <fun>
+|}]
+
+let rec fact = function
+ | 1 -> 1
+ | n -> n * (fact [@tailcall true]) (n-1)
+;;
+[%%expect {|
+Line 3, characters 13-42:
+3 | | n -> n * (fact [@tailcall true]) (n-1)
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 51 [wrong-tailcall-expectation]: expected tailcall
+val fact : int -> int = <fun>
+|}]
+
+let rec fact = function
+ | 1 -> 1
+ | n -> n * (fact [@tailcall false]) (n-1)
+;;
+[%%expect {|
+val fact : int -> int = <fun>
+|}]
+
+let rec fact_tail acc = function
+ | 1 -> acc
+ | n -> (fact_tail [@tailcall]) (n * acc) (n - 1)
+;;
+[%%expect{|
+val fact_tail : int -> int -> int = <fun>
+|}]
+
+let rec fact_tail acc = function
+ | 1 -> acc
+ | n -> (fact_tail [@tailcall true]) (n * acc) (n - 1)
+;;
+[%%expect{|
+val fact_tail : int -> int -> int = <fun>
+|}]
+
+let rec fact_tail acc = function
+ | 1 -> acc
+ | n -> (fact_tail [@tailcall false]) (n * acc) (n - 1)
+;;
+[%%expect{|
+Line 3, characters 9-56:
+3 | | n -> (fact_tail [@tailcall false]) (n * acc) (n - 1)
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 51 [wrong-tailcall-expectation]: expected non-tailcall
+val fact_tail : int -> int -> int = <fun>
+|}]
+
+
+(* explicitly test the "invalid payload" case *)
+let rec test x = (test[@tailcall foobar]) x;;
+[%%expect{|
+Line 1, characters 24-32:
+1 | let rec test x = (test[@tailcall foobar]) x;;
+ ^^^^^^^^
+Warning 47 [attribute-payload]: illegal payload for attribute 'tailcall'.
+Only an optional boolean literal is supported.
+val test : 'a -> 'b = <fun>
+|}]
File "w51_bis.ml", line 15, characters 12-48:
15 | try (foldl [@tailcall]) op (op x acc) xs
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 51: expected tailcall
+Warning 51 [wrong-tailcall-expectation]: expected tailcall
Line 1, characters 38-43:
1 | let () = try () with Invalid_argument "Any" -> ();;
^^^^^
-Warning 52: Code should not depend on the actual values of
+Warning 52 [fragile-literal-pattern]: Code should not depend on the actual values of
this constructor's arguments. They are only for information
and may change in future versions. (See manual section 9.5)
|}];;
Line 1, characters 35-46:
1 | let () = try () with Match_failure ("Any",_,_) -> ();;
^^^^^^^^^^^
-Warning 52: Code should not depend on the actual values of
+Warning 52 [fragile-literal-pattern]: Code should not depend on the actual values of
this constructor's arguments. They are only for information
and may change in future versions. (See manual section 9.5)
|}];;
Line 1, characters 35-42:
1 | let () = try () with Match_failure (_,0,_) -> ();;
^^^^^^^
-Warning 52: Code should not depend on the actual values of
+Warning 52 [fragile-literal-pattern]: Code should not depend on the actual values of
this constructor's arguments. They are only for information
and may change in future versions. (See manual section 9.5)
|}];;
Line 2, characters 7-17:
2 | | Warn "anything" -> ()
^^^^^^^^^^
-Warning 52: Code should not depend on the actual values of
+Warning 52 [fragile-literal-pattern]: Code should not depend on the actual values of
this constructor's arguments. They are only for information
and may change in future versions. (See manual section 9.5)
val f : t -> unit = <fun>
Line 2, characters 8-10:
2 | | Warn' 0n -> ()
^^
-Warning 52: Code should not depend on the actual values of
+Warning 52 [fragile-literal-pattern]: Code should not depend on the actual values of
this constructor's arguments. They are only for information
and may change in future versions. (See manual section 9.5)
val g : t -> unit = <fun>
Line 2, characters 7-34:
2 | | Deep (_ :: _ :: ("deep",_) :: _) -> ()
^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 52: Code should not depend on the actual values of
+Warning 52 [fragile-literal-pattern]: Code should not depend on the actual values of
this constructor's arguments. They are only for information
and may change in future versions. (See manual section 9.5)
val j : t -> unit = <fun>
File "w53.ml", line 12, characters 4-5:
12 | let h x = x [@inline] (* rejected *)
^
-Warning 32: unused value h.
+Warning 32 [unused-value-declaration]: unused value h.
File "w53.ml", line 12, characters 14-20:
12 | let h x = x [@inline] (* rejected *)
^^^^^^
-Warning 53: the "inline" attribute cannot appear in this context
+Warning 53 [misplaced-attribute]: the "inline" attribute cannot appear in this context
File "w53.ml", line 13, characters 14-26:
13 | let h x = x [@ocaml.inline] (* rejected *)
^^^^^^^^^^^^
-Warning 53: the "ocaml.inline" attribute cannot appear in this context
+Warning 53 [misplaced-attribute]: the "ocaml.inline" attribute cannot appear in this context
File "w53.ml", line 15, characters 14-21:
15 | let i x = x [@inlined] (* rejected *)
^^^^^^^
-Warning 53: the "inlined" attribute cannot appear in this context
+Warning 53 [misplaced-attribute]: the "inlined" attribute cannot appear in this context
File "w53.ml", line 16, characters 14-27:
16 | let j x = x [@ocaml.inlined] (* rejected *)
^^^^^^^^^^^^^
-Warning 53: the "ocaml.inlined" attribute cannot appear in this context
+Warning 53 [misplaced-attribute]: the "ocaml.inlined" attribute cannot appear in this context
File "w53.ml", line 19, characters 16-23:
19 | let l x = h x [@inlined] (* rejected *)
^^^^^^^
-Warning 53: the "inlined" attribute cannot appear in this context
+Warning 53 [misplaced-attribute]: the "inlined" attribute cannot appear in this context
File "w53.ml", line 21, characters 14-22:
21 | let m x = x [@tailcall] (* rejected *)
^^^^^^^^
-Warning 53: the "tailcall" attribute cannot appear in this context
+Warning 53 [misplaced-attribute]: the "tailcall" attribute cannot appear in this context
File "w53.ml", line 22, characters 14-28:
22 | let n x = x [@ocaml.tailcall] (* rejected *)
^^^^^^^^^^^^^^
-Warning 53: the "ocaml.tailcall" attribute cannot appear in this context
+Warning 53 [misplaced-attribute]: the "ocaml.tailcall" attribute cannot appear in this context
File "w53.ml", line 25, characters 16-24:
25 | let q x = h x [@tailcall] (* rejected *)
^^^^^^^^
-Warning 53: the "tailcall" attribute cannot appear in this context
+Warning 53 [misplaced-attribute]: the "tailcall" attribute cannot appear in this context
File "w53.ml", line 33, characters 0-32:
33 | module C = struct end [@@inline] (* rejected *)
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 53: the "inline" attribute cannot appear in this context
+Warning 53 [misplaced-attribute]: the "inline" attribute cannot appear in this context
File "w53.ml", line 34, characters 0-39:
34 | module C' = struct end [@@ocaml.inline] (* rejected *)
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 53: the "inline" attribute cannot appear in this context
+Warning 53 [misplaced-attribute]: the "inline" attribute cannot appear in this context
File "w53.ml", line 40, characters 16-22:
40 | module G = (A [@inline])(struct end) (* rejected *)
^^^^^^
-Warning 53: the "inline" attribute cannot appear in this context
+Warning 53 [misplaced-attribute]: the "inline" attribute cannot appear in this context
File "w53.ml", line 41, characters 17-29:
41 | module G' = (A [@ocaml.inline])(struct end) (* rejected *)
^^^^^^^^^^^^
-Warning 53: the "ocaml.inline" attribute cannot appear in this context
+Warning 53 [misplaced-attribute]: the "ocaml.inline" attribute cannot appear in this context
+File "w53.ml", line 45, characters 22-29:
+45 | module I = Set.Make [@inlined]
+ ^^^^^^^
+Warning 53 [misplaced-attribute]: the "inlined" attribute cannot appear in this context
+File "w53.ml", line 46, characters 23-36:
+46 | module I' = Set.Make [@ocaml.inlined]
+ ^^^^^^^^^^^^^
+Warning 53 [misplaced-attribute]: the "ocaml.inlined" attribute cannot appear in this context
+File "w53.ml", line 48, characters 23-30:
+48 | module J = Set.Make [@@inlined]
+ ^^^^^^^
+Warning 53 [misplaced-attribute]: the "inlined" attribute cannot appear in this context
+File "w53.ml", line 49, characters 24-37:
+49 | module J' = Set.Make [@@ocaml.inlined]
+ ^^^^^^^^^^^^^
+Warning 53 [misplaced-attribute]: the "ocaml.inlined" attribute cannot appear in this context
module G' = (A [@ocaml.inline])(struct end) (* rejected *)
module H = Set.Make [@inlined] (Int32) (* GPR#1808 *)
+
+module I = Set.Make [@inlined]
+module I' = Set.Make [@ocaml.inlined]
+
+module J = Set.Make [@@inlined]
+module J' = Set.Make [@@ocaml.inlined]
File "w54.ml", line 12, characters 33-39:
12 | let f = (fun x -> x) [@inline] [@inline never]
^^^^^^
-Warning 54: the "inline" attribute is used more than once on this expression
+Warning 54 [duplicated-attribute]: the "inline" attribute is used more than once on this expression
File "w54.ml", line 13, characters 51-63:
13 | let g = (fun x -> x) [@inline] [@something_else] [@ocaml.inline]
^^^^^^^^^^^^
-Warning 54: the "ocaml.inline" attribute is used more than once on this expression
+Warning 54 [duplicated-attribute]: the "ocaml.inline" attribute is used more than once on this expression
File "w54.ml", line 15, characters 26-39:
15 | let h x = (g [@inlined] [@ocaml.inlined never]) x
^^^^^^^^^^^^^
-Warning 54: the "ocaml.inlined" attribute is used more than once on this expression
+Warning 54 [duplicated-attribute]: the "ocaml.inlined" attribute is used more than once on this expression
File "w54.ml", line 19, characters 0-43:
19 | let i = ((fun x -> x) [@inline]) [@@inline]
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 54: the "inline" attribute is used more than once on this expression
+Warning 54 [duplicated-attribute]: the "inline" attribute is used more than once on this expression
File "w55.ml", line 33, characters 10-26:
33 | let h x = (j [@inlined]) x
^^^^^^^^^^^^^^^^
-Warning 55: Cannot inline: [@inlined] attributes may not be used on partial applications
+Warning 55 [inlining-impossible]: Cannot inline: [@inlined] attributes may not be used on partial applications
File "w55.ml", line 29, characters 10-27:
29 | let i x = (!r [@inlined]) x
^^^^^^^^^^^^^^^^^
-Warning 55: Cannot inline: [@inlined] attribute was not used on this function application (the optimizer did not know what function was being applied)
+Warning 55 [inlining-impossible]: Cannot inline: [@inlined] attribute was not used on this function application (the optimizer did not know what function was being applied)
File "w55.ml", line 39, characters 12-30:
39 | let b x y = (a [@inlined]) x y
^^^^^^^^^^^^^^^^^^
-Warning 55: Cannot inline: [@inlined] attribute was not used on this function application (the optimizer did not know what function was being applied)
+Warning 55 [inlining-impossible]: Cannot inline: [@inlined] attribute was not used on this function application (the optimizer did not know what function was being applied)
File "w55.ml", line 25, characters 10-26:
25 | let g x = (f [@inlined]) x
^^^^^^^^^^^^^^^^
-Warning 55: Cannot inline: Function information unavailable
+Warning 55 [inlining-impossible]: Cannot inline: Function information unavailable
File "w55.ml", line 29, characters 10-27:
29 | let i x = (!r [@inlined]) x
^^^^^^^^^^^^^^^^^
-Warning 55: Cannot inline: Unknown function
+Warning 55 [inlining-impossible]: Cannot inline: Unknown function
File "w55.ml", line 33, characters 10-26:
33 | let h x = (j [@inlined]) x
^^^^^^^^^^^^^^^^
-Warning 55: Cannot inline: Partial application
+Warning 55 [inlining-impossible]: Cannot inline: Partial application
File "w55.ml", line 39, characters 12-30:
39 | let b x y = (a [@inlined]) x y
^^^^^^^^^^^^^^^^^^
-Warning 55: Cannot inline: Over-application
+Warning 55 [inlining-impossible]: Cannot inline: Over-application
File "w55.ml", line 39, characters 12-30:
39 | let b x y = (a [@inlined]) x y
^^^^^^^^^^^^^^^^^^
-Warning 55: Cannot inline: Function information unavailable
+Warning 55 [inlining-impossible]: Cannot inline: Function information unavailable
File "w55.ml", line 42, characters 10-26:
42 | let d x = (c [@inlined]) x
^^^^^^^^^^^^^^^^
-Warning 55: Cannot inline: Function information unavailable
+Warning 55 [inlining-impossible]: Cannot inline: Function information unavailable
File "_none_", line 1:
-Warning 58: no cmx file was found in path for module Module_without_cmx, and its interface was not compiled with -opaque
+Warning 58 [no-cmx-file]: no cmx file was found in path for module Module_without_cmx, and its interface was not compiled with -opaque
File "w59.ml", line 46, characters 2-43:
46 | Obj.set_field (Obj.repr o) 0 (Obj.repr 3);
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 59: A potential assignment to a non-mutable value was detected
+Warning 59 [flambda-assignment-to-non-mutable-value]: A potential assignment to a non-mutable value was detected
in this source file. Such assignments may generate incorrect code
when using Flambda.
File "w59.ml", line 47, characters 2-43:
47 | Obj.set_field (Obj.repr p) 0 (Obj.repr 3);
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 59: A potential assignment to a non-mutable value was detected
+Warning 59 [flambda-assignment-to-non-mutable-value]: A potential assignment to a non-mutable value was detected
in this source file. Such assignments may generate incorrect code
when using Flambda.
File "w59.ml", line 48, characters 2-43:
48 | Obj.set_field (Obj.repr q) 0 (Obj.repr 3);
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 59: A potential assignment to a non-mutable value was detected
+Warning 59 [flambda-assignment-to-non-mutable-value]: A potential assignment to a non-mutable value was detected
in this source file. Such assignments may generate incorrect code
when using Flambda.
File "w59.ml", line 49, characters 2-43:
49 | Obj.set_field (Obj.repr r) 0 (Obj.repr 3)
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 59: A potential assignment to a non-mutable value was detected
+Warning 59 [flambda-assignment-to-non-mutable-value]: A potential assignment to a non-mutable value was detected
in this source file. Such assignments may generate incorrect code
when using Flambda.
File "w59.ml", line 56, characters 2-7:
56 | set o
^^^^^
-Warning 59: A potential assignment to a non-mutable value was detected
+Warning 59 [flambda-assignment-to-non-mutable-value]: A potential assignment to a non-mutable value was detected
in this source file. Such assignments may generate incorrect code
when using Flambda.
File "w60.ml", line 40, characters 13-14:
40 | let module M = struct end in
^
-Warning 60: unused module M.
+Warning 60 [unused-module]: unused module M.
--- /dev/null
+File "w68.ml", line 34, characters 33-43:
+34 | let dont_warn_with_partial_match None x = x
+ ^^^^^^^^^^
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+Some _
+File "w68.ml", line 14, characters 10-13:
+14 | let alloc {a} b = a + b
+ ^^^
+Warning 68 [match-on-mutable-state-prevent-uncurry]: This pattern depends on mutable state.
+It prevents the remaining arguments from being uncurried, which will cause additional closure allocations.
--- /dev/null
+(* TEST
+
+flags = "-w A"
+
+* setup-ocamlopt.byte-build-env
+** ocamlopt.byte
+*** check-ocamlopt.byte-output
+**** run
+***** check-program-output
+*)
+
+type a = { mutable a : int }
+
+let alloc {a} b = a + b
+
+let noalloc b {a} = b + a
+
+let measure name f =
+ let a = {a = 1} in
+ let b = 2 in
+ let before = Gc.minor_words () in
+ let (_ : int) = f ~a ~b in
+ let after = Gc.minor_words () in
+ let alloc = int_of_float (after -. before) in
+ match alloc with
+ | 0 -> Printf.printf "%S doesn't allocate\n" name
+ | _ -> Printf.printf "%S allocates\n" name
+
+let () =
+ measure "noalloc" (fun ~a ~b -> noalloc b a);
+ measure "alloc" (fun ~a ~b -> alloc a b)
+
+
+let dont_warn_with_partial_match None x = x
--- /dev/null
+"noalloc" doesn't allocate
+"alloc" allocates
/* */
/**************************************************************************/
- .globl call_gen_code
+#if defined(SYS_macosx)
+#define G(sym) _##sym
+#else
+#define G(sym) sym
+#endif
+
+ .globl G(call_gen_code)
.align 2
-call_gen_code:
+G(call_gen_code):
/* Set up stack frame and save callee-save registers */
stp x29, x30, [sp, -160]!
add x29, sp, #0
.globl caml_c_call
.align 2
-caml_c_call:
+G(caml_c_call):
br x15
+#if !defined(SYS_macosx)
/* Mark stack as non-executable */
.section .note.GNU-stack,"",%progbits
+#endif
| '-'? (['0'-'9']+ | "0x" ['0'-'9' 'a'-'f' 'A'-'F']+
| "0o" ['0'-'7']+ | "0b" ['0'-'1']+)
{ INTCONST(int_of_string(Lexing.lexeme lexbuf)) }
- | '-'? ['0'-'9']+ 'a'
- { let s = Lexing.lexeme lexbuf in
- POINTER(int_of_string(String.sub s 0 (String.length s - 1))) }
| '-'? ['0'-'9']+ ('.' ['0'-'9']*)? (['e' 'E'] ['+' '-']? ['0'-'9']+)?
{ FLOATCONST(Lexing.lexeme lexbuf) }
| ['A'-'Z' 'a'-'z' '\223'-'\246' '\248'-'\255' ]
%token NLEF
%token NLTF
%token OR
-%token <int> POINTER
%token PROJ
%token <Lambda.raise_kind> RAISE
%token RBRACKET
INTCONST { Cconst_int ($1, debuginfo ()) }
| FLOATCONST { Cconst_float (float_of_string $1, debuginfo ()) }
| STRING { Cconst_symbol ($1, debuginfo ()) }
- | POINTER { Cconst_pointer ($1, debuginfo ()) }
| IDENT { Cvar(find_ident $1) }
| LBRACKET RBRACKET { Ctuple [] }
| LPAREN LET letdef sequence RPAREN { make_letdef $3 $4 }
| LPAREN APPLY location expr exprlist machtype RPAREN
{ Cop(Capply $6, $4 :: List.rev $5, debuginfo ?loc:$3 ()) }
| LPAREN EXTCALL STRING exprlist machtype RPAREN
- {Cop(Cextcall($3, $5, false, None), List.rev $4, debuginfo ())}
+ {Cop(Cextcall($3, $5, [], false),
+ List.rev $4, debuginfo ())}
| LPAREN ALLOC exprlist RPAREN { Cop(Calloc, List.rev $3, debuginfo ()) }
| LPAREN SUBF expr RPAREN { Cop(Cnegf, [$3], debuginfo ()) }
| LPAREN SUBF expr expr RPAREN { Cop(Csubf, [$3; $4], debuginfo ()) }
prerr_string "Unbound identifier "; prerr_string s; prerr_endline "."
let debuginfo ?(loc=Location.symbol_rloc ()) () =
- Debuginfo.(from_location (Scoped_location.of_location ~scopes:[] loc))
+ Debuginfo.(from_location
+ (Scoped_location.of_location
+ ~scopes:Scoped_location.empty_scopes loc
+ )
+ )
../middle_end/linkage_name.cmi \
../typing/ident.cmi \
../middle_end/flambda/export_info.cmi \
- ../utils/config.cmi \
../middle_end/compilation_unit.cmi \
../file_formats/cmxs_format.cmi \
../file_formats/cmx_format.cmi \
../file_formats/cmt_format.cmi \
../file_formats/cmo_format.cmi \
../file_formats/cmi_format.cmi \
- ../bytecomp/bytesections.cmi
+ ../bytecomp/bytesections.cmi \
+ ../utils/binutils.cmi
objinfo.cmx : \
../bytecomp/symtable.cmx \
../middle_end/symbol.cmx \
../middle_end/linkage_name.cmx \
../typing/ident.cmx \
../middle_end/flambda/export_info.cmx \
- ../utils/config.cmx \
../middle_end/compilation_unit.cmx \
../file_formats/cmxs_format.cmi \
../file_formats/cmx_format.cmi \
../file_formats/cmt_format.cmx \
../file_formats/cmo_format.cmi \
../file_formats/cmi_format.cmx \
- ../bytecomp/bytesections.cmx
+ ../bytecomp/bytesections.cmx \
+ ../utils/binutils.cmx
+ocamlcmt.cmo : \
+ ../typing/untypeast.cmi \
+ ../typing/stypes.cmi \
+ ../parsing/pprintast.cmi \
+ ../parsing/location.cmi \
+ ../utils/load_path.cmi \
+ ../typing/envaux.cmi \
+ ../driver/compmisc.cmi \
+ ../file_formats/cmt_format.cmi \
+ ../typing/cmt2annot.cmo \
+ ../utils/clflags.cmi \
+ ../typing/annot.cmi
+ocamlcmt.cmx : \
+ ../typing/untypeast.cmx \
+ ../typing/stypes.cmx \
+ ../parsing/pprintast.cmx \
+ ../parsing/location.cmx \
+ ../utils/load_path.cmx \
+ ../typing/envaux.cmx \
+ ../driver/compmisc.cmx \
+ ../file_formats/cmt_format.cmx \
+ ../typing/cmt2annot.cmx \
+ ../utils/clflags.cmx \
+ ../typing/annot.cmi
ocamlcp.cmo : \
- ../driver/main_args.cmi
+ ../driver/main_args.cmi \
+ ../driver/compenv.cmi
ocamlcp.cmx : \
- ../driver/main_args.cmx
+ ../driver/main_args.cmx \
+ ../driver/compenv.cmx
ocamldep.cmo : \
../driver/makedepend.cmi
ocamldep.cmx : \
ocamlmklibconfig.cmo :
ocamlmklibconfig.cmx :
ocamlmktop.cmo : \
+ ../utils/config.cmi \
../utils/ccomp.cmi
ocamlmktop.cmx : \
+ ../utils/config.cmx \
../utils/ccomp.cmx
ocamloptp.cmo : \
- ../driver/main_args.cmi
+ ../driver/main_args.cmi \
+ ../driver/compenv.cmi
ocamloptp.cmx : \
- ../driver/main_args.cmx
+ ../driver/main_args.cmx \
+ ../driver/compenv.cmx
ocamlprof.cmo : \
../utils/warnings.cmi \
../parsing/parsetree.cmi \
profiling.cmx : \
profiling.cmi
profiling.cmi :
-read_cmt.cmo : \
- ../typing/untypeast.cmi \
- ../typing/stypes.cmi \
- ../parsing/pprintast.cmi \
- ../parsing/location.cmi \
- ../utils/load_path.cmi \
- ../typing/envaux.cmi \
- ../driver/compmisc.cmi \
- ../file_formats/cmt_format.cmi \
- ../typing/cmt2annot.cmo \
- ../utils/clflags.cmi \
- ../typing/annot.cmi
-read_cmt.cmx : \
- ../typing/untypeast.cmx \
- ../typing/stypes.cmx \
- ../parsing/pprintast.cmx \
- ../parsing/location.cmx \
- ../utils/load_path.cmx \
- ../typing/envaux.cmx \
- ../driver/compmisc.cmx \
- ../file_formats/cmt_format.cmx \
- ../typing/cmt2annot.cmx \
- ../utils/clflags.cmx \
- ../typing/annot.cmi
stripdebug.cmo : \
../utils/misc.cmi \
../bytecomp/bytesections.cmi
MAKEFLAGS := -r -R
ROOTDIR = ..
--include $(ROOTDIR)/Makefile.config
--include $(ROOTDIR)/Makefile.common
-
-ifeq ($(SYSTEM),unix)
-override define shellquote
-$i := $$(subst ",\",$$(subst $$$$,\$$$$,$$(subst `,\`,$i)))#")#
-endef
-$(foreach i,BINDIR LIBDIR STUBLIBDIR MANDIR,$(eval $(shellquote)))
-endif
+include $(ROOTDIR)/Makefile.common
DESTDIR ?=
# Setup GNU make variables storing per-target source and target,
# This check is defensive programming
$(and $(filter-out 1,$(words $1)),$(error \
cannot build file with whitespace in name))
-$1: $3 $2
+$(call PROGRAM_SYNONYM, $1)
+
+$1$(EXE): $3 $2
$$(CAMLC) $$(LINKFLAGS) -I $$(ROOTDIR) -o $$@ $2
-$1.opt: $3 $$(call byte2native,$2)
+$(call PROGRAM_SYNONYM, $1.opt)
+
+$1.opt$(EXE): $3 $$(call byte2native,$2)
$$(CAMLOPT_CMD) $$(LINKFLAGS) -I $$(ROOTDIR) -o $$@ \
$$(call byte2native,$2)
install_files += $1
endif
clean::
- rm -f -- $1 $1.opt
+ rm -f -- $1 $1.opt $1.exe $1.opt.exe
endef
CAMLC = $(BOOT_OCAMLC) -g -nostdlib -I $(ROOTDIR)/boot \
-use-prims $(ROOTDIR)/runtime/primitives -I $(ROOTDIR)
-CAMLOPT = $(CAMLRUN) $(ROOTDIR)/ocamlopt -g -nostdlib -I $(ROOTDIR)/stdlib
+CAMLOPT = $(CAMLRUN) $(ROOTDIR)/ocamlopt$(EXE) -g -nostdlib -I $(ROOTDIR)/stdlib
CAMLLEX = $(CAMLRUN) $(ROOTDIR)/boot/ocamllex
INCLUDES = $(addprefix -I $(ROOTDIR)/,utils parsing typing bytecomp \
middle_end middle_end/closure middle_end/flambda \
CAMLDEP_IMPORTS= \
$(ROOTDIR)/compilerlibs/ocamlcommon.cma \
$(ROOTDIR)/compilerlibs/ocamlbytecomp.cma
-ocamldep: LINKFLAGS += -compat-32
+ocamldep$(EXE): LINKFLAGS += -compat-32
$(call byte_and_opt,ocamldep,$(CAMLDEP_IMPORTS) $(CAMLDEP_OBJ),)
-ocamldep: depend.cmi
-ocamldep.opt: depend.cmi
+ocamldep$(EXE): depend.cmi
+ocamldep.opt$(EXE): depend.cmi
-# ocamldep is precious: sometimes we are stuck in the middle of a
-# bootstrap and we need to remake the dependencies
clean::
- if test -f ocamldep; then mv -f ocamldep ocamldep.bak; else :; fi
- rm -f ocamldep.opt
-
+ rm -f ocamldep ocamldep.exe ocamldep.opt ocamldep.opt.exe
# The profiler
ocamlcp_cmos = config.cmo build_path_prefix_map.cmo misc.cmo profile.cmo \
warnings.cmo identifiable.cmo numbers.cmo arg_helper.cmo \
- clflags.cmo \
+ clflags.cmo local_store.cmo \
terminfo.cmo location.cmo load_path.cmo ccomp.cmo compenv.cmo \
main_args.cmo
OCAMLMKTOP=ocamlmktop.cmo
OCAMLMKTOP_IMPORTS=config.cmo build_path_prefix_map.cmo misc.cmo \
identifiable.cmo numbers.cmo arg_helper.cmo clflags.cmo \
- load_path.cmo profile.cmo ccomp.cmo
+ local_store.cmo load_path.cmo profile.cmo ccomp.cmo
$(call byte_and_opt,ocamlmktop,$(OCAMLMKTOP_IMPORTS) $(OCAMLMKTOP),)
ifeq "$(INSTALL_BYTECODE_PROGRAMS)" "true"
for i in $(install_files); \
do \
- $(INSTALL_PROG) "$$i" "$(INSTALL_BINDIR)/$$i.byte$(EXE)"; \
- if test -f "$$i".opt; then \
- $(INSTALL_PROG) "$$i.opt" "$(INSTALL_BINDIR)/$$i.opt$(EXE)" && \
- (cd "$(INSTALL_BINDIR)/" && $(LN) "$$i.opt$(EXE)" "$$i$(EXE)"); \
+ $(INSTALL_PROG) "$$i$(EXE)" "$(INSTALL_BINDIR)/$$i.byte$(EXE)"; \
+ if test -f "$$i".opt$(EXE); then \
+ $(INSTALL_PROG) "$$i.opt$(EXE)" "$(INSTALL_BINDIR)" && \
+ (cd "$(INSTALL_BINDIR)" && $(LN) "$$i.opt$(EXE)" "$$i$(EXE)"); \
else \
- (cd "$(INSTALL_BINDIR)/" && $(LN) "$$i.byte$(EXE)" "$$i$(EXE)"); \
+ (cd "$(INSTALL_BINDIR)" && $(LN) "$$i.byte$(EXE)" "$$i$(EXE)"); \
fi; \
done
else
for i in $(install_files); \
do \
- if test -f "$$i".opt; then \
- $(INSTALL_PROG) "$$i.opt" "$(INSTALL_BINDIR)/$$i.opt$(EXE)"; \
- (cd "$(INSTALL_BINDIR)/" && $(LN) "$$i.opt$(EXE)" "$$i$(EXE)"); \
+ if test -f "$$i".opt$(EXE); then \
+ $(INSTALL_PROG) "$$i.opt$(EXE)" "$(INSTALL_BINDIR)"; \
+ (cd "$(INSTALL_BINDIR)" && $(LN) "$$i.opt$(EXE)" "$$i$(EXE)"); \
fi; \
done
endif
# The preprocessor for asm generators
-CVT_EMIT=cvt_emit.cmo
+cvt_emit := cvt_emit$(EXE)
-cvt_emit: $(CVT_EMIT)
- $(CAMLC) $(LINKFLAGS) -o cvt_emit $(CVT_EMIT)
+$(eval $(call PROGRAM_SYNONYM,cvt_emit))
-# cvt_emit is precious: sometimes we are stuck in the middle of a
-# bootstrap and we need to remake the dependencies
-.PRECIOUS: cvt_emit
-clean::
- if test -f cvt_emit; then mv -f cvt_emit cvt_emit.bak; else :; fi
+$(cvt_emit): cvt_emit.cmo
+ $(CAMLC) $(LINKFLAGS) -o $@ $^
clean::
- rm -f cvt_emit.ml
+ rm -f cvt_emit.ml cvt_emit cvt_emit.exe
beforedepend:: cvt_emit.ml
# Reading cmt files
-READ_CMT= \
+ocamlcmt_objects= \
$(ROOTDIR)/compilerlibs/ocamlcommon.cma \
$(ROOTDIR)/compilerlibs/ocamlbytecomp.cma \
\
- read_cmt.cmo
+ ocamlcmt.cmo
# Reading cmt files
-$(call byte_and_opt,read_cmt,$(READ_CMT),)
+$(call byte_and_opt,ocamlcmt,$(ocamlcmt_objects),)
install::
- if test -f read_cmt.opt; then \
- $(INSTALL_PROG) read_cmt.opt "$(INSTALL_BINDIR)/ocamlcmt$(EXE)"; \
+ if test -f ocamlcmt.opt$(EXE); then \
+ $(INSTALL_PROG)\
+ ocamlcmt.opt$(EXE) "$(INSTALL_BINDIR)/ocamlcmt$(EXE)"; \
else \
- $(INSTALL_PROG) read_cmt "$(INSTALL_BINDIR)/ocamlcmt$(EXE)"; \
+ $(INSTALL_PROG) ocamlcmt$(EXE) "$(INSTALL_BINDIR)"; \
fi
-
# The bytecode disassembler
DUMPOBJ= \
$(call byte_and_opt,dumpobj,$(DUMPOBJ),)
-make_opcodes: make_opcodes.ml
- $(CAMLC) make_opcodes.ml -o $@
+make_opcodes := make_opcodes$(EXE)
+
+$(eval $(call PROGRAM_SYNONYM,make_opcodes))
+
+$(make_opcodes): make_opcodes.ml
+ $(CAMLC) $< -o $@
-opnames.ml: $(ROOTDIR)/runtime/caml/instruct.h make_opcodes
- $(ROOTDIR)/runtime/ocamlrun make_opcodes -opnames < $< > $@
+opnames.ml: $(ROOTDIR)/runtime/caml/instruct.h $(make_opcodes)
+ $(ROOTDIR)/runtime/ocamlrun$(EXE) $(make_opcodes) -opnames < $< > $@
clean::
- rm -f opnames.ml make_opcodes make_opcodes.ml
+ rm -f opnames.ml make_opcodes make_opcodes.exe make_opcodes.ml
beforedepend:: opnames.ml
DEF_SYMBOL_PREFIX = '-Dsymbol_prefix="_"'
endif
-objinfo_helper$(EXE): objinfo_helper.$(O)
- $(CC) $(BFD_LDFLAGS) $(OC_CFLAGS) $(OUTPUTEXE)$@ $< $(BFD_LDLIBS)
-
-objinfo_helper.$(O): $(ROOTDIR)/runtime/caml/s.h
-
-objinfo_helper.$(O): \
- OC_CPPFLAGS += -I$(ROOTDIR)/runtime $(DEF_SYMBOL_PREFIX) $(BFD_CPPFLAGS)
-
OBJINFO=$(ROOTDIR)/compilerlibs/ocamlcommon.cma \
$(ROOTDIR)/compilerlibs/ocamlbytecomp.cma \
$(ROOTDIR)/compilerlibs/ocamlmiddleend.cma \
objinfo.cmo
-$(call byte_and_opt,ocamlobjinfo,$(OBJINFO),objinfo_helper$(EXE))
-
-install::
- $(INSTALL_PROG) \
- objinfo_helper$(EXE) "$(INSTALL_LIBDIR)/objinfo_helper$(EXE)"
+$(call byte_and_opt,ocamlobjinfo,$(OBJINFO),)
primreq=$(ROOTDIR)/compilerlibs/ocamlcommon.cma \
$(ROOTDIR)/compilerlibs/ocamlbytecomp.cma \
$(ROOTDIR)/otherlibs/str/str.cmxa \
lintapidiff.cmx
-lintapidiff.opt: INCLUDES+= -I $(ROOTDIR)/otherlibs/str
-lintapidiff.opt: $(LINTAPIDIFF)
+lintapidiff.opt$(EXE): INCLUDES+= -I $(ROOTDIR)/otherlibs/str
+lintapidiff.opt$(EXE): $(LINTAPIDIFF)
$(CAMLOPT_CMD) $(LINKFLAGS) -I $(ROOTDIR) -o $@ $(LINTAPIDIFF)
clean::
- rm -f -- lintapidiff.opt lintapidiff.cm? lintapidiff.o lintapidiff.obj
-
-
-clean::
- rm -f "objinfo_helper" "objinfo_helper.manifest"
- rm -f "objinfo_helper.exe" "objinfo_helper.exe.manifest"
+ rm -f -- lintapidiff.opt lintapidiff.opt.exe
+ rm -f lintapidiff.cm? lintapidiff.o lintapidiff.obj
# Eventlog metadata file
$(call byte_and_opt,cmpbyt,$(CMPBYT),)
-CAMLTEX= $(ROOTDIR)/compilerlibs/ocamlcommon.cma \
- $(ROOTDIR)/compilerlibs/ocamlbytecomp.cma \
- $(ROOTDIR)/compilerlibs/ocamltoplevel.cma \
- $(ROOTDIR)/otherlibs/str/str.cma \
- $(ROOTDIR)/otherlibs/$(UNIXLIB)/unix.cma \
- caml_tex.ml
+caml_tex_files := \
+ $(ROOTDIR)/compilerlibs/ocamlcommon.cma \
+ $(ROOTDIR)/compilerlibs/ocamlbytecomp.cma \
+ $(ROOTDIR)/compilerlibs/ocamltoplevel.cma \
+ $(ROOTDIR)/otherlibs/str/str.cma \
+ $(ROOTDIR)/otherlibs/$(UNIXLIB)/unix.cma \
+ caml_tex.ml
#Scan latex files, and run ocaml code examples
-caml-tex: INCLUDES += $(addprefix -I $(ROOTDIR)/otherlibs/,str $(UNIXLIB))
-caml-tex: $(CAMLTEX)
- $(ROOTDIR)/runtime/ocamlrun $(ROOTDIR)/ocamlc -nostdlib \
+caml_tex := caml-tex$(EXE)
+
+$(caml_tex): INCLUDES += $(addprefix -I $(ROOTDIR)/otherlibs/,str $(UNIXLIB))
+$(caml_tex): $(caml_tex_files)
+ $(ROOTDIR)/runtime/ocamlrun$(EXE) $(ROOTDIR)/ocamlc$(EXE) -nostdlib \
-I $(ROOTDIR)/stdlib $(LINKFLAGS) -linkall \
- -o $@ -no-alias-deps $(CAMLTEX)
+ -o $@ -no-alias-deps $^
# we need str and unix which depend on the bytecode version of other tools
# thus we delay building caml-tex to the opt.opt stage
ifneq "$(WITH_CAMLTEX)" ""
-opt.opt:caml-tex
+opt.opt: $(caml_tex)
endif
clean::
- rm -f -- caml-tex caml_tex.cm?
+ rm -f -- caml-tex caml-tex.exe caml_tex.cm?
# Common stuff
let camlprefix = "caml"
let latex_escape s = String.concat "" ["$"; s; "$"]
-let camlin = latex_escape {|\\?|} ^ {|\1|}
-let camlout = latex_escape {|\\:|} ^ {|\1|}
+let toplevel_prompt= latex_escape {|\?|} ^ " "
+
let camlbunderline = "<<"
let camleunderline = ">>"
let catch_warning =
function
| [] -> None
- | s :: _ when string_match ~!{|Warning \([0-9]+\):|} s 0 ->
+ | s :: _ when string_match ~!{|Warning \([0-9]+\)\( \[[a-z-]+\]\)?:|} s 0 ->
Some (Warning (int_of_string @@ matched_group 1 s))
| _ -> None
end
+let format_input mode s = match mode with
+ | Verbatim | Signature -> s
+ | Toplevel ->
+ match String.split_on_char '\n' s with
+ | [] -> assert false
+ | a :: q -> String.concat ~sep:"\n " ((toplevel_prompt^a)::q)
+
let process_file file =
let ic = try open_in file with _ -> failwith "Cannot read input file" in
let phrase_start = ref 1 and phrase_stop = ref 1 in
file !phrase_stop phrase in
(* Special characters may also appear in output strings -Didier *)
let output = Text_transform.escape_specials output in
- let phrase = global_replace ~!{|^\(.\)|} camlin phrase
- and output = global_replace ~!{|^\(.\)|} camlout output in
- let final_output =
- if omit_answer && String.length error_msgs > 0 then
- global_replace ~!{|^\(.\)|} camlout error_msgs
- else if omit_answer then ""
- else output in
+ let phrase = format_input mode phrase in
+ let final_output = if omit_answer then error_msgs else output in
start tex_fmt phrase_env [];
code_env input_env tex_fmt phrase;
if String.length final_output > 0 then
# is faster to optimistically run check-typo on them (and maybe get
# out in the middle) than to first check then run.
-TEST_AWK='BEGIN {if ("a{1}" ~ /a{1}/) exit 0}'
-if $OCAML_CT_AWK "$TEST_AWK" ; then
- TEST_AWK='BEGIN {if ("a" ~ /a{1}/) exit 0}'
+TEST_AWK='BEGIN {if ("a{1}" ~ /a{1}$/) exit 1}'
+if ! $OCAML_CT_AWK "$TEST_AWK" ; then
if $OCAML_CT_AWK --re-interval "$TEST_AWK" 2>/dev/null ; then
OCAML_CT_AWK="$OCAML_CT_AWK --re-interval"
else
--- /dev/null
+#!/usr/bin/env bash
+#**************************************************************************
+#* *
+#* OCaml *
+#* *
+#* Anil Madhavapeddy, OCaml Labs *
+#* *
+#* Copyright 2014 Institut National de Recherche en Informatique et *
+#* en Automatique. *
+#* *
+#* All rights reserved. This file is distributed under the terms of *
+#* the GNU Lesser General Public License version 2.1, with the *
+#* special exception on linking described in the file LICENSE. *
+#* *
+#**************************************************************************
+
+set -xe
+
+PREFIX=~/local
+
+MAKE="make $MAKE_ARG"
+SHELL=dash
+
+export PATH=$PREFIX/bin:$PATH
+
+Configure () {
+ mkdir -p $PREFIX
+ cat<<EOF
+------------------------------------------------------------------------
+This test builds the OCaml compiler distribution with your pull request
+and runs its testsuite.
+
+Failing to build the compiler distribution, or testsuite failures are
+critical errors that must be understood and fixed before your pull
+request can be merged.
+------------------------------------------------------------------------
+EOF
+
+ configure_flags="\
+ --prefix=$PREFIX \
+ --enable-flambda-invariants \
+ --enable-ocamltest \
+ --disable-dependency-generation \
+ $CONFIG_ARG"
+
+ case $XARCH in
+ x64)
+ ./configure $configure_flags
+ ;;
+ i386)
+ ./configure --build=x86_64-pc-linux-gnu --host=i386-linux \
+ CC='gcc -m32' AS='as --32' ASPP='gcc -m32 -c' \
+ PARTIALLD='ld -r -melf_i386' \
+ $configure_flags
+ ;;
+ *)
+ echo unknown arch
+ exit 1
+ ;;
+ esac
+}
+
+Build () {
+ $MAKE world.opt
+ $MAKE ocamlnat
+ echo Ensuring that all names are prefixed in the runtime
+ ./tools/check-symbol-names runtime/*.a
+}
+
+Test () {
+ cd testsuite
+ echo Running the testsuite with the normal runtime
+ $MAKE all
+ echo Running the testsuite with the debug runtime
+ $MAKE USE_RUNTIME='d' OCAMLTESTDIR="$(pwd)/_ocamltestd" TESTLOG=_logd all
+ cd ..
+}
+
+API_Docs () {
+ echo Ensuring that all library documentation compiles
+ $MAKE -C ocamldoc html_doc pdf_doc texi_doc
+}
+
+Install () {
+ $MAKE install
+}
+
+Checks () {
+ if fgrep 'SUPPORTS_SHARED_LIBRARIES=true' Makefile.config &>/dev/null ; then
+ echo Check the code examples in the manual
+ $MAKE manual-pregen
+ fi
+ # check_all_arches checks tries to compile all backends in place,
+ # we would need to redo (small parts of) world.opt afterwards to
+ # use the compiler again
+ $MAKE check_all_arches
+ # Ensure that .gitignore is up-to-date - this will fail if any untreacked or
+ # altered files exist.
+ test -z "$(git status --porcelain)"
+ # check that the 'clean' target also works
+ $MAKE clean
+ $MAKE -C manual clean
+ # check that the `distclean` target definitely cleans the tree
+ $MAKE distclean
+ # Check the working tree is clean
+ test -z "$(git status --porcelain)"
+ # Check that there are no ignored files
+ test -z "$(git ls-files --others -i --exclude-standard)"
+}
+
+CheckManual () {
+ cat<<EOF
+--------------------------------------------------------------------------
+This test checks the global structure of the reference manual
+(e.g. missing chapters).
+--------------------------------------------------------------------------
+EOF
+ # we need some of the configuration data provided by configure
+ ./configure
+ $MAKE check-stdlib check-case-collision -C manual/tests
+
+}
+
+case $1 in
+configure) Configure;;
+build) Build;;
+test) Test;;
+api-docs) API_Docs;;
+install) Install;;
+other-checks) Checks;;
+*) echo "Unknown CI instruction: $1"
+ exit 1;;
+esac
set CYGWIN_PACKAGES=cygwin make diffutils\r
set CYGWIN_COMMANDS=cygcheck make diff\r
if "%PORT%" equ "mingw32" (\r
- set CYGWIN_PACKAGES=%CYGWIN_PACKAGES% mingw64-i686-gcc-core\r
- set CYGWIN_COMMANDS=%CYGWIN_COMMANDS% i686-w64-mingw32-gcc\r
+ rem mingw64-i686-runtime does not need explictly 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
)\r
\r
set CYGWIN_INSTALL_PACKAGES=\r
# Takes 3 arguments
# $1:the Windows port. Recognized values: mingw, msvc and msvc64
# $2: the prefix to use to install
-# $3: C compiler flags to use to turn warnings into errors
function set_configuration {
case "$1" in
mingw)
build='--build=i686-pc-cygwin'
host='--host=i686-w64-mingw32'
+ dep='--disable-dependency-generation'
;;
msvc)
build='--build=i686-pc-cygwin'
host='--host=i686-pc-windows'
+ dep='--disable-dependency-generation'
;;
msvc64)
build='--build=x86_64-unknown-cygwin'
host='--host=x86_64-pc-windows'
+ # Explicitly test dependency generation on msvc64
+ dep='--enable-dependency-generation'
;;
esac
mkdir -p "$CACHE_DIRECTORY"
./configure --cache-file="$CACHE_DIRECTORY/config.cache-$1" \
- $build $host --prefix="$2" --enable-ocamltest || ( \
+ $dep $build $host --prefix="$2" --enable-ocamltest || ( \
rm -f "$CACHE_DIRECTORY/config.cache-$1" ; \
./configure --cache-file="$CACHE_DIRECTORY/config.cache-$1" \
- $build $host --prefix="$2" --enable-ocamltest )
+ $dep $build $host --prefix="$2" --enable-ocamltest )
- FILE=$(pwd | cygpath -f - -m)/Makefile.config
- echo "Edit $FILE to turn C compiler warnings into errors"
- sed -i -e '/^ *OC_CFLAGS *=/s/\r\?$/ '"$3"'\0/' "$FILE"
+# FILE=$(pwd | cygpath -f - -m)/Makefile.config
# run "Content of $FILE" cat Makefile.config
}
msvc32-only)
cd "$APPVEYOR_BUILD_FOLDER/../$BUILD_PREFIX-msvc32"
- set_configuration msvc "$OCAMLROOT-msvc32" -WX
+ set_configuration msvc "$OCAMLROOT-msvc32"
run "$MAKE world" $MAKE world
run "$MAKE runtimeopt" $MAKE runtimeopt
fi
if [[ $PORT = 'msvc64' ]] ; then
- set_configuration msvc64 "$OCAMLROOT" -WX
+ set_configuration msvc64 "$OCAMLROOT"
else
- set_configuration mingw "$OCAMLROOT-mingw32" -Werror
+ set_configuration mingw "$OCAMLROOT-mingw32"
fi
cd "$APPVEYOR_BUILD_FOLDER/../$BUILD_PREFIX-$PORT"
--- /dev/null
+This directory contains the configuration files of the Jenkins jobs
+used to test OCaml on Inria's continuous integration infrastructure.
+
+Each subdirectory under `tools/ci/inria` corresponds to one CI job
+and should contain at least a `Jenkinsfile` describing the pipeline
+associated with this job(1). In addition, the job's directory can also
+contain a `script` file specifying the commands used to actually execute
+the job. Other files may be included as appropriate.
+
+(1) The Jenkinsfiles can follow either the declarative syntax documented
+at https://www.jenkins.io/doc/book/pipeline/syntax, or the advanced
+(scripted) one documented at
+https://www.jenkins.io/doc/book/pipeline/jenkinsfile/#advanced-scripted-pipeline
--- /dev/null
+/**************************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Sebastien Hinderer, 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. */
+/* */
+/**************************************************************************/
+
+/* Pipeline for the Risc-V job on Inria's CI */
+
+pipeline {
+ agent { label 'olive' }
+ options {
+ timeout(time: 3, unit: 'HOURS')
+ }
+ stages {
+ stage('Verifying that OCaml commpiles on a Risc-V virtual machine') {
+ steps {
+ sh 'ssh -p 10000 riscv@localhost GIT_COMMIT=${GIT_COMMIT} ' +
+ 'flambda=false /home/riscv/run-ci'
+ }
+ }
+ }
+ post {
+ regression {
+ emailext (
+ to: 'ocaml-ci-notifications@inria.fr',
+ subject: 'Job $JOB_NAME $BUILD_STATUS (build #$BUILD_NUMBER)',
+ body: 'Changes since the last successful build:\n\n' +
+ '${CHANGES, format="%r %a %m"}\n\n' +
+ 'See the attached build log or check console output here:\n' +
+ '$BUILD_URL\n',
+ /* recipientProviders: [[$class: 'DevelopersRecipientProvider']], */
+ attachLog: true
+ )
+ }
+ }
+}
+++ /dev/null
-#!/bin/sh
-#**************************************************************************
-#* *
-#* OCaml *
-#* *
-#* Damien Doligez, projet Gallium, INRIA Rocquencourt *
-#* *
-#* Copyright 2014 Institut National de Recherche en Informatique et *
-#* en Automatique. *
-#* *
-#* All rights reserved. This file is distributed under the terms of *
-#* the GNU Lesser General Public License version 2.1, with the *
-#* special exception on linking described in the file LICENSE. *
-#* *
-#**************************************************************************
-
-# This script is run on Inria's continuous-integration servers to make sure
-# it is possible to bootstrap the compiler.
-
-# To know the slave's architecture, this script looks at the OCAML_ARCH
-# environment variable. For a given node NODE, this variable can be defined
-# in Jenkins at the following address:
-# https://ci.inria.fr/ocaml/computer/NODE/configure
-
-# Other environments variables that are honored:
-# OCAML_CONFIGURE_OPTIONS additional options for configure
-# OCAML_JOBS number of jobs to run in parallel (make -j)
-
-# Command-line arguments:
-# -conf configure-option add configure-option to configure cmd line
-# -patch1 file-name apply patch with -p1
-# -no-native do not build "opt" and "opt.opt"
-# -jNN pass "-jNN" option to make for parallel builds
-
-error () {
- echo "$1" >&2
- exit 3
-}
-
-arch_error() {
- configure_url="https://ci.inria.fr/ocaml/computer/${NODE_NAME}/configure"
- msg="Unknown architecture. Make sure the OCAML_ARCH environment"
- msg="$msg variable has been defined."
- msg="$msg\nSee ${configure_url}"
- error "$msg"
-}
-
-# Kill a task on Windows
-# Errors are ignored
-kill_task()
-{
- task=$1
- taskkill /f /im ${task} /t || true
-}
-
-quote1 () {
- printf "'%s'" "`printf %s "$1" | sed -e "s/'/'\\\\\\\\''/g"`";
-}
-
-# Functions used to modify the source code
-
-change_exe_magic_number() {
- old=`./runtime/ocamlrun -M`
- 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}\
-'\x22/#define EXEC_MAGIC "'${new}'"/' runtime/caml/exec.h
- # Change magic number in utils/config.mlp
- sed -i 's/let \+exec_magic_number \+= \+\x22'${old}\
-'\x22/let exec_magic_number = "'${new}'"/' utils/config.mlp
-}
-
-remove_primitive()
-{
- echo Removing the \'sinh\' primitive
- patch -p1 < tools/ci/inria/remove-sinh-primitive.patch
-}
-
-#########################################################################
-# be verbose
-set -x
-
-#########################################################################
-# Save the current directory (on cygwin, /etc/profile changes it)
-jenkinsdir="$(pwd)"
-echo jenkinsdir=${jenkinsdir}
-
-#########################################################################
-# If we are called from a Windows batch script, we must set up the
-# Unix environment variables (e.g. PATH).
-
-case "${OCAML_ARCH}" in
- bsd|macos|linux) ;;
- cygwin|cygwin64|mingw|mingw64)
- . /etc/profile
- . "$HOME/.profile"
- ;;
- msvc)
- . /etc/profile
- . "$HOME/.profile"
- . "$HOME/.msenv32"
- ;;
- msvc64)
- . /etc/profile
- . "$HOME/.profile"
- . "$HOME/.msenv64"
- ;;
- solaris)
- echo OCaml 4.11 does not support Solaris. Exiting.
- exit
- ;;
- *) arch_error;;
-esac
-
-#########################################################################
-
-# be considerate towards other potential users of the test machine
-case "${OCAML_ARCH}" in
- bsd|macos|linux) renice 10 $$ ;;
-esac
-
-# be verbose and stop on error
-set -ex
-
-#########################################################################
-# set up variables
-
-# default values
-make=make
-instdir="$HOME/ocaml-tmp-install"
-confoptions="--enable-ocamltest ${OCAML_CONFIGURE_OPTIONS}"
-make_native=true
-cleanup=false
-check_make_alldepend=false
-dorebase=false
-jobs=''
-build=''
-host=''
-
-case "${OCAML_ARCH}" in
- bsd) make=gmake ;;
- macos) ;;
- linux)
- check_make_alldepend=true
- ;;
- cygwin)
- cleanup=true
- check_make_alldepend=true
- ;;
- cygwin64)
- cleanup=true
- check_make_alldepend=true
- dorebase=true
- ;;
- mingw)
- build='--build=i686-pc-cygwin'
- host='--host=i686-w64-mingw32'
- instdir='C:/ocamlmgw'
- cleanup=true
- check_make_alldepend=true
- ;;
- mingw64)
- build='--build=x86_64-unknown-cygwin'
- host='--host=x86_64-w64-mingw32'
- instdir='C:/ocamlmgw64'
- cleanup=true
- check_make_alldepend=true
- ;;
- msvc)
- build='--build=i686-pc-cygwin'
- host='--host=i686-pc-windows'
- instdir='C:/ocamlms'
- configure=nt
- cleanup=true
- ;;
- msvc64)
- build='--build=x86_64-unknown-cygwin'
- host='--host=x86_64-pc-windows'
- instdir='C:/ocamlms64'
- configure=nt
- cleanup=true
- ;;
- *) arch_error;;
-esac
-
-# Make sure two builds won't use the same install directory
-instdir="$instdir-$$"
-
-case "${OCAML_JOBS}" in
- [1-9]|[1-9][0-9]) jobs="-j${OCAML_JOBS}" ;;
-esac
-
-#########################################################################
-# On Windows, cleanup processes that may remain from previous run
-
-if $cleanup; then
- tasks="tee ocamlrun program ocamltest ocamltest.opt"
- for task in ${tasks}; do kill_task ${task}.exe; done
-fi
-
-#########################################################################
-# Go to the right directory
-
-pwd
-cd "$jenkinsdir"
-
-#########################################################################
-# parse optional command-line arguments (has to be done after the "cd")
-
-while [ $# -gt 0 ]; do
- case $1 in
- -conf) confoptions="$confoptions `quote1 "$2"`"; shift;;
- -patch1) patch -f -p1 <"$2"; shift;;
- -no-native) make_native=false;;
- -j[1-9]|-j[1-9][0-9]) jobs="$1";;
- *) error "unknown option $1";;
- esac
- shift
-done
-
-#########################################################################
-# Do the work
-
-# Tell gcc to use only ASCII in its diagnostic outputs.
-export LC_ALL=C
-
-$make -s distclean || :
-
-# `make distclean` does not clean the files from previous versions that
-# are not produced by the current version, so use `git clean` in addition.
-git clean -f -d -x
-
-# Also make a hard reset
-git reset --hard HEAD
-
-if $flambda; then
- confoptions="$confoptions -enable-flambda --enable-flambda-invariants"
-fi
-eval "./configure $build $host --prefix='$instdir' $confoptions"
-
-$make world
-
-change_exe_magic_number "CI-bootstrap"
-
-remove_primitive
-
-$make coreall
-$make bootstrap
--- /dev/null
+/**************************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Sebastien Hinderer, 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. */
+/* */
+/**************************************************************************/
+
+/* Pipeline for the bootstrap job on Inria's CI */
+
+/* Make sure the OCaml compiler can still be bootstrapped */
+
+pipeline {
+ agent { label 'ocaml-linux-64' }
+ options {
+ timeout(time: 1, unit: 'HOURS')
+ }
+ stages {
+ stage('Verifying that the OCaml compiler can be bootstrapped') {
+ steps {
+ sh 'tools/ci/inria/bootstrap/script'
+ }
+ }
+ }
+ post {
+ regression {
+ emailext (
+ to: 'ocaml-ci-notifications@inria.fr',
+ subject: 'Job $JOB_NAME $BUILD_STATUS (build #$BUILD_NUMBER)',
+ body: 'Changes since the last successful build:\n\n' +
+ '${CHANGES, format="%r %a %m"}\n\n' +
+ 'See the attached build log or check console output here:\n' +
+ '$BUILD_URL\n',
+ /* recipientProviders: [[$class: 'DevelopersRecipientProvider']], */
+ attachLog: true
+ )
+ }
+ }
+}
--- /dev/null
+The patch below removes the 'sinh' primitive from the OCaml runtime
+and standard library.
+
+It is used on Inria's CI to make sure the bootstrap procedure works.
+
+diff --git a/runtime/floats.c b/runtime/floats.c
+index b93f6a409..6edbed9c6 100644
+--- a/runtime/floats.c
++++ b/runtime/floats.c
+@@ -536,11 +536,6 @@ CAMLprim value caml_sin_float(value f)
+ return caml_copy_double(sin(Double_val(f)));
+ }
+
+-CAMLprim value caml_sinh_float(value f)
+-{
+- return caml_copy_double(sinh(Double_val(f)));
+-}
+-
+ CAMLprim value caml_cos_float(value f)
+ {
+ return caml_copy_double(cos(Double_val(f)));
+diff --git a/stdlib/float.ml b/stdlib/float.ml
+index 8d9c5cca6..3b3ca61bc 100644
+--- a/stdlib/float.ml
++++ b/stdlib/float.ml
+@@ -69,8 +69,6 @@ external hypot : float -> float -> float
+ = "caml_hypot_float" "caml_hypot" [@@unboxed] [@@noalloc]
+ external cosh : float -> float = "caml_cosh_float" "cosh"
+ [@@unboxed] [@@noalloc]
+-external sinh : float -> float = "caml_sinh_float" "sinh"
+- [@@unboxed] [@@noalloc]
+ external tanh : float -> float = "caml_tanh_float" "tanh"
+ [@@unboxed] [@@noalloc]
+ external ceil : float -> float = "caml_ceil_float" "ceil"
+diff --git a/stdlib/float.mli b/stdlib/float.mli
+index 2cdd31608..904f4af0e 100644
+--- a/stdlib/float.mli
++++ b/stdlib/float.mli
+@@ -196,10 +196,6 @@ external cosh : float -> float = "caml_cosh_float" "cosh"
+ [@@unboxed] [@@noalloc]
+ (** Hyperbolic cosine. Argument is in radians. *)
+
+-external sinh : float -> float = "caml_sinh_float" "sinh"
+-[@@unboxed] [@@noalloc]
+-(** Hyperbolic sine. Argument is in radians. *)
+-
+ external tanh : float -> float = "caml_tanh_float" "tanh"
+ [@@unboxed] [@@noalloc]
+ (** Hyperbolic tangent. Argument is in radians. *)
+diff --git a/stdlib/pervasives.ml b/stdlib/pervasives.ml
+index 945512716..55bc9e921 100644
+--- a/stdlib/pervasives.ml
++++ b/stdlib/pervasives.ml
+@@ -97,8 +97,6 @@ external hypot : float -> float -> float = "caml_hypot_float" "caml_hypot"
+ [@@unboxed] [@@noalloc]
+ external cosh : float -> float = "caml_cosh_float" "cosh"
+ [@@unboxed] [@@noalloc]
+-external sinh : float -> float = "caml_sinh_float" "sinh"
+- [@@unboxed] [@@noalloc]
+ external tanh : float -> float = "caml_tanh_float" "tanh"
+ [@@unboxed] [@@noalloc]
+ external ceil : float -> float = "caml_ceil_float" "ceil"
+diff --git a/stdlib/stdlib.ml b/stdlib/stdlib.ml
+index 425728f64..4057dbc90 100644
+--- a/stdlib/stdlib.ml
++++ b/stdlib/stdlib.ml
+@@ -148,8 +148,6 @@ external log10 : float -> float = "caml_log10_float" "log10"
+ external log1p : float -> float = "caml_log1p_float" "caml_log1p"
+ [@@unboxed] [@@noalloc]
+ external sin : float -> float = "caml_sin_float" "sin" [@@unboxed] [@@noalloc]
+-external sinh : float -> float = "caml_sinh_float" "sinh"
+- [@@unboxed] [@@noalloc]
+ external sqrt : float -> float = "caml_sqrt_float" "sqrt"
+ [@@unboxed] [@@noalloc]
+ external tan : float -> float = "caml_tan_float" "tan" [@@unboxed] [@@noalloc]
+diff --git a/stdlib/stdlib.mli b/stdlib/stdlib.mli
+index d451bba9c..990a41467 100644
+--- a/stdlib/stdlib.mli
++++ b/stdlib/stdlib.mli
+@@ -461,10 +461,6 @@ external cosh : float -> float = "caml_cosh_float" "cosh"
+ [@@unboxed] [@@noalloc]
+ (** Hyperbolic cosine. Argument is in radians. *)
+
+-external sinh : float -> float = "caml_sinh_float" "sinh"
+- [@@unboxed] [@@noalloc]
+-(** Hyperbolic sine. Argument is in radians. *)
+-
+ external tanh : float -> float = "caml_tanh_float" "tanh"
+ [@@unboxed] [@@noalloc]
+ (** Hyperbolic tangent. Argument is in radians. *)
--- /dev/null
+#!/bin/sh
+#**************************************************************************
+#* *
+#* OCaml *
+#* *
+#* Damien Doligez, projet Gallium, INRIA Rocquencourt *
+#* *
+#* Copyright 2014 Institut National de Recherche en Informatique et *
+#* en Automatique. *
+#* *
+#* All rights reserved. This file is distributed under the terms of *
+#* the GNU Lesser General Public License version 2.1, with the *
+#* special exception on linking described in the file LICENSE. *
+#* *
+#**************************************************************************
+
+# This script is run on Inria's continuous-integration servers to make sure
+# it is possible to bootstrap the compiler.
+
+# To know the slave's architecture, this script looks at the OCAML_ARCH
+# environment variable. For a given node NODE, this variable can be defined
+# in Jenkins at the following address:
+# https://ci.inria.fr/ocaml/computer/NODE/configure
+
+# Other environments variables that are honored:
+# OCAML_CONFIGURE_OPTIONS additional options for configure
+# OCAML_JOBS number of jobs to run in parallel (make -j)
+
+# Command-line arguments:
+# -conf configure-option add configure-option to configure cmd line
+# -patch1 file-name apply patch with -p1
+# -no-native do not build "opt" and "opt.opt"
+# -jNN pass "-jNN" option to make for parallel builds
+
+error () {
+ echo "$1" >&2
+ exit 3
+}
+
+arch_error() {
+ configure_url="https://ci.inria.fr/ocaml/computer/${NODE_NAME}/configure"
+ msg="Unknown architecture. Make sure the OCAML_ARCH environment"
+ msg="$msg variable has been defined."
+ msg="$msg\nSee ${configure_url}"
+ error "$msg"
+}
+
+# Kill a task on Windows
+# Errors are ignored
+kill_task()
+{
+ task=$1
+ taskkill /f /im ${task} /t || true
+}
+
+quote1 () {
+ printf "'%s'" "`printf %s "$1" | sed -e "s/'/'\\\\\\\\''/g"`";
+}
+
+# Functions used to modify the source code
+
+change_exe_magic_number() {
+ old=`./runtime/ocamlrun -M`
+ 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}\
+'\x22/#define EXEC_MAGIC "'${new}'"/' runtime/caml/exec.h
+ # Change magic number in utils/config.mlp
+ sed -i 's/let \+exec_magic_number \+= \+\x22'${old}\
+'\x22/let exec_magic_number = "'${new}'"/' utils/config.mlp
+}
+
+remove_primitive()
+{
+ echo Removing the \'sinh\' primitive
+ patch -p1 < tools/ci/inria/bootstrap/remove-sinh-primitive.patch
+}
+
+#########################################################################
+# be verbose
+set -x
+
+#########################################################################
+# Save the current directory (on cygwin, /etc/profile changes it)
+jenkinsdir="$(pwd)"
+echo jenkinsdir=${jenkinsdir}
+
+#########################################################################
+# If we are called from a Windows batch script, we must set up the
+# Unix environment variables (e.g. PATH).
+
+case "${OCAML_ARCH}" in
+ bsd|macos|linux|solaris) ;;
+ cygwin|cygwin64|mingw|mingw64)
+ . /etc/profile
+ . "$HOME/.profile"
+ ;;
+ msvc)
+ . /etc/profile
+ . "$HOME/.profile"
+ . "$HOME/.msenv32"
+ ;;
+ msvc64)
+ . /etc/profile
+ . "$HOME/.profile"
+ . "$HOME/.msenv64"
+ ;;
+ *) arch_error;;
+esac
+
+#########################################################################
+
+# be considerate towards other potential users of the test machine
+case "${OCAML_ARCH}" in
+ bsd|macos|linux) renice 10 $$ ;;
+esac
+
+# be verbose and stop on error
+set -ex
+
+#########################################################################
+# set up variables
+
+# default values
+make=make
+instdir="$HOME/ocaml-tmp-install"
+confoptions="--enable-ocamltest --enable-dependency-generation \
+${OCAML_CONFIGURE_OPTIONS}"
+make_native=true
+cleanup=false
+check_make_alldepend=false
+dorebase=false
+jobs=''
+build=''
+host=''
+
+case "${OCAML_ARCH}" in
+ bsd|solaris) make=gmake ;;
+ macos) ;;
+ linux)
+ check_make_alldepend=true
+ ;;
+ cygwin)
+ cleanup=true
+ check_make_alldepend=true
+ ;;
+ cygwin64)
+ cleanup=true
+ check_make_alldepend=true
+ dorebase=true
+ ;;
+ mingw)
+ build='--build=i686-pc-cygwin'
+ host='--host=i686-w64-mingw32'
+ instdir='C:/ocamlmgw'
+ cleanup=true
+ check_make_alldepend=true
+ ;;
+ mingw64)
+ build='--build=x86_64-unknown-cygwin'
+ host='--host=x86_64-w64-mingw32'
+ instdir='C:/ocamlmgw64'
+ cleanup=true
+ check_make_alldepend=true
+ ;;
+ msvc)
+ build='--build=i686-pc-cygwin'
+ host='--host=i686-pc-windows'
+ instdir='C:/ocamlms'
+ configure=nt
+ cleanup=true
+ ;;
+ msvc64)
+ build='--build=x86_64-unknown-cygwin'
+ host='--host=x86_64-pc-windows'
+ instdir='C:/ocamlms64'
+ configure=nt
+ cleanup=true
+ ;;
+ *) arch_error;;
+esac
+
+# Make sure two builds won't use the same install directory
+instdir="$instdir-$$"
+
+case "${OCAML_JOBS}" in
+ [1-9]|[1-9][0-9]) jobs="-j${OCAML_JOBS}" ;;
+esac
+
+#########################################################################
+# On Windows, cleanup processes that may remain from previous run
+
+if $cleanup; then
+ tasks="tee ocamlrun program ocamltest ocamltest.opt"
+ for task in ${tasks}; do kill_task ${task}.exe; done
+fi
+
+#########################################################################
+# Go to the right directory
+
+pwd
+cd "$jenkinsdir"
+
+#########################################################################
+# parse optional command-line arguments (has to be done after the "cd")
+
+while [ $# -gt 0 ]; do
+ case $1 in
+ -conf) confoptions="$confoptions `quote1 "$2"`"; shift;;
+ -patch1) patch -f -p1 <"$2"; shift;;
+ -no-native) make_native=false;;
+ -j[1-9]|-j[1-9][0-9]) jobs="$1";;
+ *) error "unknown option $1";;
+ esac
+ shift
+done
+
+#########################################################################
+# Do the work
+
+# Tell gcc to use only ASCII in its diagnostic outputs.
+export LC_ALL=C
+
+$make -s distclean || :
+
+# `make distclean` does not clean the files from previous versions that
+# are not produced by the current version, so use `git clean` in addition.
+git clean -f -d -x
+
+# Also make a hard reset
+git reset --hard HEAD
+
+if $flambda; then
+ confoptions="$confoptions -enable-flambda --enable-flambda-invariants"
+fi
+eval "./configure $build $host --prefix='$instdir' $confoptions"
+
+$make world
+
+change_exe_magic_number "CI-bootstrap"
+
+remove_primitive
+
+$make coreall
+$make bootstrap
--- /dev/null
+/**************************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Sebastien Hinderer, 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. */
+/* */
+/**************************************************************************/
+
+/* Pipeline for the check-typo job on Inria's CI */
+
+pipeline {
+ agent { label 'ocaml-linux-64' }
+ options {
+ timeout(time: 1, unit: 'HOURS')
+ }
+ stages {
+ stage('Checking code style') {
+ steps {
+ sh '''
+ if [ ! -x tools/check-typo ] ; then
+ echo "tools/check-typo does not appear to be executable?"; >2;
+ exit 1;
+ fi
+ tools/check-typo
+ '''
+ }
+ }
+ }
+ post {
+ regression {
+ emailext (
+ to: 'ocaml-ci-notifications@inria.fr',
+ subject: 'Job $JOB_NAME $BUILD_STATUS (build #$BUILD_NUMBER)',
+ body: 'Changes since the last successful build:\n\n' +
+ '${CHANGES, format="%r %a %m"}\n\n' +
+ 'See the attached build log or check console output here:\n' +
+ '$BUILD_URL\n',
+ /* recipientProviders: [[$class: 'DevelopersRecipientProvider']], */
+ attachLog: true
+ )
+ }
+ }
+}
+++ /dev/null
-#!/bin/sh
-
-#**************************************************************************
-#* *
-#* OCaml *
-#* *
-#* Xavier Leroy, projet Cambium, INRIA Paris-Rocquencourt *
-#* *
-#* 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. *
-#* *
-#**************************************************************************
-
-# Test the Dune-based build
-
-set -ex
-eval $(opam env)
-export LC_ALL=C
-git clean -q -f -d -x
-./configure
-dune build -j2 @libs
--- /dev/null
+/**************************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Sebastien Hinderer, 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. */
+/* */
+/**************************************************************************/
+
+/* Pipeline for the dune-build job on Inria's CI */
+
+pipeline {
+ agent { label 'ocaml-linux-64' }
+ options {
+ timeout(time: 1, unit: 'HOURS')
+ }
+ stages {
+ stage('Building the OCaml compiler with Dune') {
+ steps {
+ sh 'tools/ci/inria/dune-build/script'
+ }
+ }
+ }
+ post {
+ regression {
+ emailext (
+ to: 'Sebastien.Hinderer@inria.fr, thomas.refis@gmail.com',
+ subject: 'Job $JOB_NAME $BUILD_STATUS (build #$BUILD_NUMBER)',
+ body: 'Changes since the last successful build:\n\n' +
+ '${CHANGES, format="%r %a %m"}\n\n' +
+ 'See the attached build log or check console output here:\n' +
+ '$BUILD_URL\n',
+ /* recipientProviders: [[$class: 'DevelopersRecipientProvider']], */
+ attachLog: true
+ )
+ }
+ }
+}
--- /dev/null
+#!/bin/sh
+
+#**************************************************************************
+#* *
+#* OCaml *
+#* *
+#* Xavier Leroy, projet Cambium, INRIA Paris-Rocquencourt *
+#* *
+#* 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. *
+#* *
+#**************************************************************************
+
+# Test the Dune-based build
+
+set -ex
+eval $(opam env)
+export LC_ALL=C
+git clean -q -f -d -x
+./configure
+dune build -j2 @libs
+++ /dev/null
-#!/bin/sh
-#**************************************************************************
-#* *
-#* OCaml *
-#* *
-#* Damien Doligez, Xavier Leroy, projet Gallium, INRIA Paris *
-#* *
-#* Copyright 2018 Institut National de Recherche en Informatique et *
-#* en Automatique. *
-#* *
-#* All rights reserved. This file is distributed under the terms of *
-#* the GNU Lesser General Public License version 2.1, with the *
-#* special exception on linking described in the file LICENSE. *
-#* *
-#**************************************************************************
-
-# This script is run on Inria's continuous-integration servers to recompile
-# from scratch, adding more run-time checks ("sanitizers") to the C code,
-# and run the test suite.
-
-# In this context, it is necessary to skip a few tests whose behaviour
-# is modified by the instrumentation:
-
-export OCAMLTEST_SKIP_TESTS="tests/afl-instrumentation/afltest.ml \
-tests/runtime-errors/stackoverflow.ml"
-
-# To know the slave's architecture, this script looks at the OCAML_ARCH
-# environment variable. For a given node NODE, this variable can be defined
-# in Jenkins at the following address:
-# https://ci.inria.fr/ocaml/computer/NODE/configure
-
-# Other environment variables that are honored:
-# OCAML_JOBS number of jobs to run in parallel (make -j)
-
-# Command-line arguments:
-# -jNN pass "-jNN" option to make for parallel builds
-
-error () {
- echo "$1" >&2
- exit 3
-}
-
-arch_error() {
- configure_url="https://ci.inria.fr/ocaml/computer/${NODE_NAME}/configure"
- msg="Unknown architecture. Make sure the OCAML_ARCH environment"
- msg="$msg variable has been defined."
- msg="$msg\nSee ${configure_url}"
- error "$msg"
-}
-
-# Change a variable in Makefile.config
-# Usage: set_config_var <variable name> <new value>
-
-
-set_config_var() {
- conffile=Makefile.config
- mv ${conffile} ${conffile}.bak
- (grep -v "^$1=" ${conffile}.bak; echo "$1=$2") > ${conffile}
-}
-
-#########################################################################
-# stop on error
-set -e
-
-# be considerate towards other potential users of the test machine
-case "${OCAML_ARCH}" in
- bsd|macos|linux) renice 10 $$ ;;
-esac
-
-# set up variables
-
-make=make
-jobs=''
-
-case "${OCAML_ARCH}" in
- bsd) make=gmake ;;
- macos) ;;
- linux) ;;
- cygwin|cygwin64|mingw|mingw64|msvc|msvc64)
- error "Don't run this test under Windows";;
- solaris)
- echo OCaml 4.11 does not support Solaris. Exiting.
- exit
- ;;
- *) arch_error;;
-esac
-
-case "${OCAML_JOBS}" in
- [1-9]|[1-9][0-9]) jobs="-j${OCAML_JOBS}" ;;
-esac
-
-# parse optional command-line arguments
-
-while [ $# -gt 0 ]; do
- case $1 in
- -j[1-9]|-j[1-9][0-9]) jobs="$1";;
- *) error "unknown option $1";;
- esac
- shift
-done
-
-# Tell gcc to use only ASCII in its diagnostic outputs.
-export LC_ALL=C
-
-# How to run the test suite
-if test -n "$jobs" && test -x /usr/bin/parallel; then
- export PARALLEL="$jobs $PARALLEL"
- run_testsuite="$make -C testsuite parallel"
-else
- run_testsuite="$make -C testsuite all"
-fi
-
-# A tool that make error backtrace nicer
-# Need to pick the one that matches clang-9 and is named "llvm-symbolizer"
-# (/usr/bin/llvm-symbolizer-9 doesn't work, that would be too easy)
-export ASAN_SYMBOLIZER_PATH=/usr/lib/llvm-9/bin/llvm-symbolizer
-export TSAN_SYMBOLIZER_PATH="$ASAN_SYMBOLIZER_PATH"
-
-#########################################################################
-
-# Cleanup repository
-git clean -q -f -d -x
-
-# Ensure that the repo still passes the check-typo script
-if [ ! -x tools/check-typo ] ; then
- error "tools/check-typo does not appear to be executable?"
-fi
-tools/check-typo
-
-#########################################################################
-
-echo "======== old school build =========="
-
-instdir="$HOME/ocaml-tmp-install-$$"
-./configure --prefix "$instdir"
-
-# Build the system without using world.opt
-make $jobs world
-make $jobs opt
-make $jobs opt.opt
-make install
-
-rm -rf "$instdir"
-
-# It's a build system test only, so we don't bother testing the compiler
-
-#########################################################################
-
-echo "======== clang 9, address sanitizer, UB sanitizer =========="
-
-git clean -q -f -d -x
-
-# Use clang 9
-# We cannot give the sanitizer options as part of -cc because
-# then various autoconfiguration tests fail.
-# Instead, we'll fix OC_CFLAGS a posteriori.
-./configure CC=clang-9 --disable-stdlib-manpages
-
-# These are the undefined behaviors we want to check
-# Others occur on purpose e.g. signed arithmetic overflow
-ubsan="\
-bool,\
-builtin,\
-bounds,\
-enum,\
-nonnull-attribute,\
-nullability,\
-object-size,\
-pointer-overflow,\
-returns-nonnull-attribute,\
-shift-exponent,\
-unreachable"
-
-# Select address sanitizer and UB sanitizer, with trap-on-error behavior
-# Don't optimize too much to get better backtraces of errors
-set_config_var OC_CFLAGS "-O1 \
--fno-strict-aliasing -fwrapv -fno-omit-frame-pointer \
--Wall -Werror \
--fsanitize=address \
--fsanitize-trap=$ubsan"
-
-# Build the system. We want to check for memory leaks, hence
-# 1- force ocamlrun to free memory before exiting
-# 2- add an exception for ocamlyacc, which doesn't free memory
-
-OCAMLRUNPARAM="c=1" \
-LSAN_OPTIONS="suppressions=$(pwd)/tools/ci/inria/lsan-suppr.txt" \
-make $jobs world.opt
-
-# Run the testsuite.
-# We deactivate leak detection for two reasons:
-# - The suppressed leak detections related to ocamlyacc mess up the
-# output of the tests and are reported as failures by ocamltest.
-# - The Ocaml runtime does not free the memory when a fatal error
-# occurs.
-
-# We already use sigaltstack for stack overflow detection. Our use
-# interacts with ASAN's. Hence, we tell ASAN not to use it.
-
-ASAN_OPTIONS="detect_leaks=0,use_sigaltstack=0" $run_testsuite
-
-#########################################################################
-
-echo "======== clang 9, thread sanitizer =========="
-
-git clean -q -f -d -x
-
-./configure CC=clang-9 --disable-stdlib-manpages
-
-# Select thread sanitizer
-# Don't optimize too much to get better backtraces of errors
-set_config_var OC_CFLAGS "-O1 \
--fno-strict-aliasing -fwrapv -fno-omit-frame-pointer \
--Wall -Werror \
--fsanitize=thread"
-
-# Build the system
-make $jobs world.opt
-
-# Run the testsuite.
-# ThreadSanitizer complains about fork() in threaded programs,
-# we ask it to just continue in this case.
-TSAN_OPTIONS="die_after_fork=0" $run_testsuite
-
-#########################################################################
-
-# This is a failed attempt at using the memory sanitizer
-# (to detect reads from uninitialized memory).
-# Some alarms are reported that look like false positive
-# and are impossible to debug.
-
-# echo "======== clang 6.0, memory sanitizer =========="
-
-# git clean -q -f -d -x
-
-# # Use clang 6.0
-# # We cannot give the sanitizer options as part of -cc because
-# # then various autoconfiguration tests fail.
-# # Instead, we'll fix OC_CFLAGS a posteriori.
-# # Memory sanitizer doesn't like the static data generated by ocamlopt,
-# # hence build bytecode only
-# ./configure CC=clang-9 --disable-native-compiler
-
-# # Select memory sanitizer
-# # Don't optimize at all to get better backtraces of errors
-# set_config_var OC_CFLAGS "-O0 -g \
-# -fno-strict-aliasing -fwrapv -fno-omit-frame-pointer \
-# -Wall -Werror \
-# -fsanitize=memory"
-
-# # A tool that make error backtrace nicer
-# # Need to pick the one that matches clang-6.0
-# export MSAN_SYMBOLIZER_PATH=/usr/lib/llvm-6.0/bin/llvm-symbolizer
-
-# # Build the system (bytecode only) and test
-# make $jobs world
-# $run_testsuite
--- /dev/null
+#!/bin/sh
+#**************************************************************************
+#* *
+#* OCaml *
+#* *
+#* Damien Doligez and Xavier Leroy, 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. *
+#* *
+#**************************************************************************
+
+# This script performs a minimal build of the OCaml system
+# sufficient to run the test suite.
+# It is a lightweight version of the 'main' script, intended to run
+# on slow machines such as QEMU virtual machines.
+# It does not work under Windows.
+
+# Environment variables that are honored:
+# OCAML_ARCH architecture of the test machine
+# OCAML_JOBS number of jobs to run in parallel (make -j)
+
+# Command-line arguments:
+# -jNN pass "-jNN" option to make for parallel builds
+
+error () {
+ echo "$1" >&2
+ exit 3
+}
+
+# be verbose and stop on error
+set -ex
+
+# set up variables
+
+# default values
+make=make
+jobs=''
+
+case "${OCAML_ARCH}" in
+ bsd|solaris)
+ make=gmake
+ ;;
+ cygwin|cygwin64|mingw|mingw64|msvc|msvc64)
+ error "Unsupported architecture ${OCAML_ARCH}"
+ ;;
+esac
+
+case "${OCAML_JOBS}" in
+ [1-9]|[1-9][0-9]) jobs="-j${OCAML_JOBS}" ;;
+esac
+
+#########################################################################
+# parse optional command-line arguments
+
+while [ $# -gt 0 ]; do
+ case $1 in
+ -j[1-9]|-j[1-9][0-9]) jobs="$1";;
+ *) error "unknown option $1";;
+ esac
+ shift
+done
+
+#########################################################################
+# Do the work
+
+# Tell gcc to use only ASCII in its diagnostic outputs.
+export LC_ALL=C
+
+git clean -q -f -d -x
+
+./configure \
+ --disable-shared \
+ --disable-debug-runtime \
+ --disable-instrumented-runtime \
+ --disable-dependency-generation \
+ --disable-ocamldoc \
+ --disable-stdlib-manpages
+
+$make $jobs --warn-undefined-variables
+
+cd testsuite
+if test -n "$jobs" && test -x /usr/bin/parallel
+then PARALLEL="$jobs $PARALLEL" $make --warn-undefined-variables parallel
+else $make --warn-undefined-variables all
+fi
+++ /dev/null
-# ocamlyacc doesn't clean memory on exit
-leak:ocamlyacc
# Unix environment variables (e.g. PATH).
case "${OCAML_ARCH}" in
- bsd|macos|linux) ;;
+ bsd|macos|linux|solaris) ;;
cygwin|cygwin64|mingw|mingw64)
. /etc/profile
. "$HOME/.profile"
. "$HOME/.profile"
. "$HOME/.msenv64"
;;
- solaris)
- echo OCaml 4.11 does not support Solaris. Exiting.
- exit
- ;;
*) arch_error;;
esac
ocaml-ppc-64)
CCOMP="CC='gcc -m64'"
OCAML_CONFIGURE_OPTIONS=;;
- ocaml-openbsd-64)
- OCAML_CONFIGURE_OPTIONS='--with-bfd'
esac
#########################################################################
conffile=Makefile.config
make=make
instdir="$HOME/ocaml-tmp-install"
-confoptions="--enable-ocamltest ${OCAML_CONFIGURE_OPTIONS}"
+confoptions="--enable-ocamltest --enable-dependency-generation \
+${OCAML_CONFIGURE_OPTIONS}"
make_native=true
cleanup=false
check_make_alldepend=false
dorebase=false
jobs=''
+bootstrap=false
case "${OCAML_ARCH}" in
- bsd)
+ bsd|solaris)
make=gmake
;;
macos)
- confoptions="$confoptions --with-bfd "
+ # Nothing special but we must not fall through the "arch_error" case
;;
linux)
check_make_alldepend=true
-patch1) patch -f -p1 <"$2"; shift;;
-no-native) make_native=false;;
-j[1-9]|-j[1-9][0-9]) jobs="$1";;
+ -with-bootstrap) bootstrap=true;;
*) error "unknown option $1";;
esac
shift
git clean -q -f -d -x
if $flambda; then
- confoptions="$confoptions --enable-flambda --enable-flambda-invariants"
+ confoptions="$confoptions --enable-flambda --enable-flambda-invariants \
+--disable-naked-pointers"
fi
eval ./configure "$CCOMP" $build $host --prefix='$instdir' $confoptions
-if $make_native; then
- $make $jobs --warn-undefined-variables
- if $check_make_alldepend; then $make --warn-undefined-variables alldepend; fi
+if $bootstrap; then
+ $make $jobs --warn-undefined-variables core
+ $make $jobs --warn-undefined-variables coreboot
+ if $make_native; then
+ $make $jobs --warn-undefined-variables opt.opt
+ else
+ $make $jobs --warn-undefined-variables all
+ fi
else
$make $jobs --warn-undefined-variables
fi
+
+
+if $make_native && $check_make_alldepend; then
+ $make --warn-undefined-variables alldepend
+fi
+
if $dorebase; then
# temporary solution to the cygwin fork problem
# see https://github.com/alainfrisch/flexdll/issues/50
rebase -b 0x7cd20000 otherlibs/unix/dllunix.so
rebase -b 0x7cdc0000 otherlibs/systhreads/dllthreads.so
fi
-$make --warn-undefined-variables install
+$make --warn-undefined-variables install
rm -rf "$instdir"
+
cd testsuite
if test -n "$jobs" && test -x /usr/bin/parallel
then PARALLEL="$jobs $PARALLEL" $make --warn-undefined-variables parallel
else $make --warn-undefined-variables all
fi
+
+if $bootstrap; then
+ git checkout ../boot/ocamlc ../boot/ocamllex
+fi
+++ /dev/null
-#!/bin/sh
-#**************************************************************************
-#* *
-#* OCaml *
-#* *
-#* Sebastien Hinderer, projet Gallium, INRIA Paris *
-#* *
-#* Copyright 2017 Institut National de Recherche en Informatique et *
-#* en Automatique. *
-#* *
-#* All rights reserved. This file is distributed under the terms of *
-#* the GNU Lesser General Public License version 2.1, with the *
-#* special exception on linking described in the file LICENSE. *
-#* *
-#**************************************************************************
-
-# Commands to run for the 'other-configs' job on Inria's CI
-
-# Stop on error
-set -e
-
-mainjob=./tools/ci/inria/main
-main="${mainjob} -j8"
-
-${main} -conf --disable-native-compiler -no-native
-${main} -conf --disable-naked-pointers
-${main} -conf --disable-flat-float-array
-${main} -conf --enable-flambda -conf --disable-naked-pointers
-OCAMLRUNPARAM="c=1" ${main}
--- /dev/null
+/**************************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Sebastien Hinderer, 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. */
+/* */
+/**************************************************************************/
+
+/* Pipeline for the other-configs job on Inria's CI */
+
+/* Test various other compiler configurations */
+
+pipeline {
+ agent { label 'ocaml-linux-64' }
+ options {
+ timeout(time: 45, unit: 'MINUTES')
+ }
+ stages {
+ stage('Testing various other compiler configurations') {
+ steps {
+ sh 'tools/ci/inria/other-configs/script'
+ }
+ }
+ }
+ post {
+ regression {
+ emailext (
+ to: 'ocaml-ci-notifications@inria.fr',
+ subject: 'Job $JOB_NAME $BUILD_STATUS (build #$BUILD_NUMBER)',
+ body: 'Changes since the last successful build:\n\n' +
+ '${CHANGES, format="%r %a %m"}\n\n' +
+ 'See the attached build log or check console output here:\n' +
+ '$BUILD_URL\n',
+ /* recipientProviders: [[$class: 'DevelopersRecipientProvider']], */
+ attachLog: true
+ )
+ }
+ }
+}
--- /dev/null
+#!/bin/sh
+#**************************************************************************
+#* *
+#* OCaml *
+#* *
+#* Sebastien Hinderer, projet Gallium, INRIA Paris *
+#* *
+#* Copyright 2017 Institut National de Recherche en Informatique et *
+#* en Automatique. *
+#* *
+#* All rights reserved. This file is distributed under the terms of *
+#* the GNU Lesser General Public License version 2.1, with the *
+#* special exception on linking described in the file LICENSE. *
+#* *
+#**************************************************************************
+
+# Commands to run for the 'other-configs' job on Inria's CI
+
+# Stop on error
+set -e
+
+mainjob=./tools/ci/inria/main
+main="${mainjob} -j8"
+
+# The "MIN_BUILD" (formerly on Travis) builds with everything disabled (apart
+# from ocamltest). Its goals:
+# - Ensure that the system builds correctly without native compilation
+# - Ensure ocamltest builds correctly with Unix
+# - Ensure the testsuite runs correctly with everything switched off
+${main} -conf --disable-native-compiler \
+ -conf --disable-shared \
+ -conf --disable-debug-runtime \
+ -conf --disable-instrumented-runtime \
+ -conf --disable-systhreads \
+ -conf --disable-str-lib \
+ -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} -with-bootstrap -conf --disable-flat-float-array
+${main} -conf --enable-flambda -conf --disable-naked-pointers
+${main} -conf --enable-reserved-header-bits=27
+OCAMLRUNPARAM="c=1" ${main}
+++ /dev/null
-The patch below removes the 'sinh' primitive from the OCaml runtime
-and standard library.
-
-It is used on Inria's CI to make sure the bootstrap procedure works.
-
-diff --git a/runtime/floats.c b/runtime/floats.c
-index b93f6a409..6edbed9c6 100644
---- a/runtime/floats.c
-+++ b/runtime/floats.c
-@@ -536,11 +536,6 @@ CAMLprim value caml_sin_float(value f)
- return caml_copy_double(sin(Double_val(f)));
- }
-
--CAMLprim value caml_sinh_float(value f)
--{
-- return caml_copy_double(sinh(Double_val(f)));
--}
--
- CAMLprim value caml_cos_float(value f)
- {
- return caml_copy_double(cos(Double_val(f)));
-diff --git a/stdlib/float.ml b/stdlib/float.ml
-index 8d9c5cca6..3b3ca61bc 100644
---- a/stdlib/float.ml
-+++ b/stdlib/float.ml
-@@ -69,8 +69,6 @@ external hypot : float -> float -> float
- = "caml_hypot_float" "caml_hypot" [@@unboxed] [@@noalloc]
- external cosh : float -> float = "caml_cosh_float" "cosh"
- [@@unboxed] [@@noalloc]
--external sinh : float -> float = "caml_sinh_float" "sinh"
-- [@@unboxed] [@@noalloc]
- external tanh : float -> float = "caml_tanh_float" "tanh"
- [@@unboxed] [@@noalloc]
- external ceil : float -> float = "caml_ceil_float" "ceil"
-diff --git a/stdlib/float.mli b/stdlib/float.mli
-index 2cdd31608..904f4af0e 100644
---- a/stdlib/float.mli
-+++ b/stdlib/float.mli
-@@ -196,10 +196,6 @@ external cosh : float -> float = "caml_cosh_float" "cosh"
- [@@unboxed] [@@noalloc]
- (** Hyperbolic cosine. Argument is in radians. *)
-
--external sinh : float -> float = "caml_sinh_float" "sinh"
--[@@unboxed] [@@noalloc]
--(** Hyperbolic sine. Argument is in radians. *)
--
- external tanh : float -> float = "caml_tanh_float" "tanh"
- [@@unboxed] [@@noalloc]
- (** Hyperbolic tangent. Argument is in radians. *)
-diff --git a/stdlib/pervasives.ml b/stdlib/pervasives.ml
-index 945512716..55bc9e921 100644
---- a/stdlib/pervasives.ml
-+++ b/stdlib/pervasives.ml
-@@ -97,8 +97,6 @@ external hypot : float -> float -> float = "caml_hypot_float" "caml_hypot"
- [@@unboxed] [@@noalloc]
- external cosh : float -> float = "caml_cosh_float" "cosh"
- [@@unboxed] [@@noalloc]
--external sinh : float -> float = "caml_sinh_float" "sinh"
-- [@@unboxed] [@@noalloc]
- external tanh : float -> float = "caml_tanh_float" "tanh"
- [@@unboxed] [@@noalloc]
- external ceil : float -> float = "caml_ceil_float" "ceil"
-diff --git a/stdlib/stdlib.ml b/stdlib/stdlib.ml
-index 425728f64..4057dbc90 100644
---- a/stdlib/stdlib.ml
-+++ b/stdlib/stdlib.ml
-@@ -148,8 +148,6 @@ external log10 : float -> float = "caml_log10_float" "log10"
- external log1p : float -> float = "caml_log1p_float" "caml_log1p"
- [@@unboxed] [@@noalloc]
- external sin : float -> float = "caml_sin_float" "sin" [@@unboxed] [@@noalloc]
--external sinh : float -> float = "caml_sinh_float" "sinh"
-- [@@unboxed] [@@noalloc]
- external sqrt : float -> float = "caml_sqrt_float" "sqrt"
- [@@unboxed] [@@noalloc]
- external tan : float -> float = "caml_tan_float" "tan" [@@unboxed] [@@noalloc]
-diff --git a/stdlib/stdlib.mli b/stdlib/stdlib.mli
-index d451bba9c..990a41467 100644
---- a/stdlib/stdlib.mli
-+++ b/stdlib/stdlib.mli
-@@ -461,10 +461,6 @@ external cosh : float -> float = "caml_cosh_float" "cosh"
- [@@unboxed] [@@noalloc]
- (** Hyperbolic cosine. Argument is in radians. *)
-
--external sinh : float -> float = "caml_sinh_float" "sinh"
-- [@@unboxed] [@@noalloc]
--(** Hyperbolic sine. Argument is in radians. *)
--
- external tanh : float -> float = "caml_tanh_float" "tanh"
- [@@unboxed] [@@noalloc]
- (** Hyperbolic tangent. Argument is in radians. *)
--- /dev/null
+/**************************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Sebastien Hinderer, 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. */
+/* */
+/**************************************************************************/
+
+/* Pipeline for the sanitizers job on Inria's CI */
+
+pipeline {
+ agent { label 'ocaml-linux-64' }
+ options {
+ timeout(time: 1, unit: 'HOURS')
+ }
+ stages {
+ stage('Compiling and testing OCaml with sanitizers') {
+ steps {
+ sh 'tools/ci/inria/sanitizers/script'
+ }
+ }
+ }
+ post {
+ regression {
+ emailext (
+ to: 'ocaml-ci-notifications@inria.fr',
+ subject: 'Job $JOB_NAME $BUILD_STATUS (build #$BUILD_NUMBER)',
+ body: 'Changes since the last successful build:\n\n' +
+ '${CHANGES, format="%r %a %m"}\n\n' +
+ 'See the attached build log or check console output here:\n' +
+ '$BUILD_URL\n',
+ /* recipientProviders: [[$class: 'DevelopersRecipientProvider']], */
+ attachLog: true
+ )
+ }
+ }
+}
--- /dev/null
+# ocamlyacc doesn't clean memory on exit
+leak:ocamlyacc
--- /dev/null
+#!/bin/sh
+#**************************************************************************
+#* *
+#* OCaml *
+#* *
+#* Damien Doligez, Xavier Leroy, projet Gallium, INRIA Paris *
+#* *
+#* Copyright 2018 Institut National de Recherche en Informatique et *
+#* en Automatique. *
+#* *
+#* All rights reserved. This file is distributed under the terms of *
+#* the GNU Lesser General Public License version 2.1, with the *
+#* special exception on linking described in the file LICENSE. *
+#* *
+#**************************************************************************
+
+# This script is run on Inria's continuous-integration servers to recompile
+# from scratch, adding more run-time checks ("sanitizers") to the C code,
+# and run the test suite.
+
+# In this context, it is necessary to skip a few tests whose behaviour
+# is modified by the instrumentation:
+
+export OCAMLTEST_SKIP_TESTS="tests/afl-instrumentation/afltest.ml \
+tests/runtime-errors/stackoverflow.ml"
+
+jobs=-j8
+make=make
+
+#########################################################################
+
+# Print each command before its execution
+set -x
+
+# stop on error
+set -e
+
+# Tell gcc to use only ASCII in its diagnostic outputs.
+export LC_ALL=C
+
+# How to run the test suite
+if test -n "$jobs" && test -x /usr/bin/parallel; then
+ export PARALLEL="$jobs $PARALLEL"
+ run_testsuite="$make -C testsuite parallel"
+else
+ run_testsuite="$make -C testsuite all"
+fi
+
+# A tool that makes error backtraces nicer
+# Need to pick the one that matches clang-9 and is named "llvm-symbolizer"
+# (/usr/bin/llvm-symbolizer-9 doesn't work, that would be too easy)
+export ASAN_SYMBOLIZER_PATH=/usr/lib/llvm-9/bin/llvm-symbolizer
+export TSAN_SYMBOLIZER_PATH="$ASAN_SYMBOLIZER_PATH"
+
+#########################################################################
+
+echo "======== clang 9, address sanitizer, UB sanitizer =========="
+
+git clean -q -f -d -x
+
+# Use clang 9
+
+# These are the undefined behaviors we want to check
+# Others occur on purpose e.g. signed arithmetic overflow
+ubsan="\
+bool,\
+builtin,\
+bounds,\
+enum,\
+nonnull-attribute,\
+nullability,\
+object-size,\
+pointer-overflow,\
+returns-nonnull-attribute,\
+shift-exponent,\
+unreachable"
+
+# Select address sanitizer and UB sanitizer, with trap-on-error behavior
+sanitizers="-fsanitize=address -fsanitize-trap=$ubsan"
+
+# Don't optimize too much to get better backtraces of errors
+
+./configure \
+ CC=clang-9 \
+ CFLAGS="-O1 -fno-omit-frame-pointer $sanitizers" \
+ --disable-stdlib-manpages --enable-dependency-generation
+
+# Build the system. We want to check for memory leaks, hence
+# 1- force ocamlrun to free memory before exiting
+# 2- add an exception for ocamlyacc, which doesn't free memory
+
+OCAMLRUNPARAM="c=1" \
+LSAN_OPTIONS="suppressions=$(pwd)/tools/ci/inria/sanitizers/lsan-suppr.txt" \
+make $jobs
+
+# Run the testsuite.
+# We deactivate leak detection for two reasons:
+# - The suppressed leak detections related to ocamlyacc mess up the
+# output of the tests and are reported as failures by ocamltest.
+# - The Ocaml runtime does not free the memory when a fatal error
+# occurs.
+
+# We already use sigaltstack for stack overflow detection. Our use
+# interacts with ASAN's. Hence, we tell ASAN not to use it.
+
+ASAN_OPTIONS="detect_leaks=0,use_sigaltstack=0" $run_testsuite
+
+#########################################################################
+
+echo "======== clang 9, thread sanitizer =========="
+
+git clean -q -f -d -x
+
+# Select thread sanitizer
+# Don't optimize too much to get better backtraces of errors
+
+./configure \
+ CC=clang-9 \
+ CFLAGS="-O1 -fno-omit-frame-pointer -fsanitize=thread" \
+ --disable-stdlib-manpages --enable-dependency-generation
+
+# Build the system
+make $jobs
+
+# ThreadSanitizer has problems with processes that exit via
+# pthread_exit in the last thread.
+# It also reports errors for the error case of unlocking an
+# error-checking mutex.
+# Exclude the corresponding test
+export OCAMLTEST_SKIP_TESTS="$OCAMLTEST_SKIP_TESTS \
+tests/lib-threads/pr9971.ml \
+tests/statmemprof/thread_exit_in_callback.ml \
+tests/lib-threads/mutex_errors.ml"
+
+# Run the testsuite.
+# ThreadSanitizer complains about fork() in threaded programs,
+# we ask it to just continue in this case.
+TSAN_OPTIONS="die_after_fork=0" $run_testsuite
+
+#########################################################################
+
+# This is a failed attempt at using the memory sanitizer
+# (to detect reads from uninitialized memory).
+# Some alarms are reported that look like false positive
+# and are impossible to debug.
+
+# echo "======== clang 6.0, memory sanitizer =========="
+
+# git clean -q -f -d -x
+
+# # Use clang 6.0
+# # Memory sanitizer doesn't like the static data generated by ocamlopt,
+# # hence build bytecode only
+# # Select memory sanitizer
+# # Don't optimize at all to get better backtraces of errors
+
+# ./configure \
+# CC=clang-9 \
+# CFLAGS="-O0 -g -fno-omit-frame-pointer -fsanitize=memory" \
+# --disable-native-compiler
+# # A tool that makes error backtraces nicer
+# # Need to pick the one that matches clang-6.0
+# export MSAN_SYMBOLIZER_PATH=/usr/lib/llvm-6.0/bin/llvm-symbolizer
+
+# # Build the system (bytecode only) and test
+# make $jobs
+# $run_testsuite
--- /dev/null
+/**************************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Sebastien Hinderer, 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. */
+/* */
+/**************************************************************************/
+
+/* Pipeline for the step-by-step-build job on Inria's CI */
+
+/* Build OCaml the legacy way (without using the world.opt target) */
+
+pipeline {
+ agent { label 'ocaml-linux-64' }
+ options {
+ timeout(time: 1, unit: 'HOURS')
+ }
+ stages {
+ stage(
+ 'Building the OCaml compiler step by step (without using world.opt)'
+ ) {
+ steps {
+ sh 'tools/ci/inria/step-by-step-build/script'
+ }
+ }
+ }
+ post {
+ regression {
+ emailext (
+ to: 'ocaml-ci-notifications@inria.fr',
+ subject: 'Job $JOB_NAME $BUILD_STATUS (build #$BUILD_NUMBER)',
+ body: 'Changes since the last successful build:\n\n' +
+ '${CHANGES, format="%r %a %m"}\n\n' +
+ 'See the attached build log or check console output here:\n' +
+ '$BUILD_URL\n',
+ /* recipientProviders: [[$class: 'DevelopersRecipientProvider']], */
+ attachLog: true
+ )
+ }
+ }
+}
--- /dev/null
+#!/bin/sh
+#**************************************************************************
+#* *
+#* OCaml *
+#* *
+#* Sebastien Hinderer 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. *
+#* *
+#**************************************************************************
+
+jobs=-j8
+instdir="$HOME/ocaml-tmp-install-$$"
+./configure --prefix "$instdir" --disable-dependency-generation
+make $jobs world
+make $jobs opt
+make $jobs opt.opt
+make install
+rm -rf "$instdir"
+# It's a build system test only, so we don't bother testing the compiler
PREFIX=~/local
-MAKE=make SHELL=dash
+MAKE="make $MAKE_ARG"
+SHELL=dash
TRAVIS_CUR_HEAD=${TRAVIS_COMMIT_RANGE%%...*}
TRAVIS_PR_HEAD=${TRAVIS_COMMIT_RANGE##*...}
TRAVIS_MERGE_BASE=$(git merge-base "$TRAVIS_CUR_HEAD" "$TRAVIS_PR_HEAD");;
esac
+CheckSyncStdlibDocs () {
+ cat<<EOF
+------------------------------------------------------------------------
+This test checks that running tools/sync-stdlib-docs is a no-op in the current
+state, which means that the labelled/unlabelled .mli files are in sync. If
+this check fails, it should be fixable by just running the script and reviewing
+the changes it makes.
+------------------------------------------------------------------------
+EOF
+ tools/sync_stdlib_docs
+ git diff --quiet --exit-code && result=pass || result=fail
+ case $result in
+ pass)
+ echo "CheckSyncStdlibDocs: success";;
+ fail)
+ echo "CheckSyncStdlibDocs: failure with the following differences:"
+ git --no-pager diff
+ exit 1;;
+ esac
+}
+
+CheckDepend () {
+ cat<<EOF
+------------------------------------------------------------------------
+This test checks that 'alldepend' target is a no-op in the current
+state, which means that dependencies are correctly stored in .depend
+files. It should only be run after the compiler has been built.
+If this check fails, it should be fixable by just running 'make alldepend'.
+------------------------------------------------------------------------
+EOF
+ ./configure --disable-dependency-generation \
+ --disable-debug-runtime \
+ --disable-instrumented-runtime
+ # Need a runtime
+ $MAKE -j coldstart
+ # And generated files (ocamllex compiles ocamlyacc)
+ $MAKE -j ocamllex
+ $MAKE alldepend
+ # note: we cannot use $? as (set -e) may be set globally,
+ # and disabling it locally is not worth the hassle.
+ # note: we ignore the whitespace in case different C dependency
+ # detectors use different indentation styles.
+ git diff --ignore-all-space --quiet --exit-code **.depend \
+ && result=pass || result=fail
+ case $result in
+ pass)
+ echo "CheckDepend: success";;
+ fail)
+ echo "CheckDepend: failure with the following differences:"
+ git --no-pager diff --ignore-all-space **.depend
+ exit 1;;
+ esac
+}
+
BuildAndTest () {
mkdir -p $PREFIX
cat<<EOF
--disable-ocamldoc \
--disable-native-compiler \
--enable-ocamltest \
+ --disable-dependency-generation \
$CONFIG_ARG"
else
configure_flags="\
--prefix=$PREFIX \
--enable-flambda-invariants \
--enable-ocamltest \
+ --disable-dependency-generation \
$CONFIG_ARG"
fi
case $XARCH in
./configure $configure_flags
;;
i386)
- ./configure --build=x86_64-pc-linux-gnu --host=i386-pc-linux-gnu \
- AS='as' ASPP='gcc -c' \
+ ./configure --build=x86_64-pc-linux-gnu --host=i386-linux \
+ CC='gcc -m32' AS='as --32' ASPP='gcc -m32 -c' \
+ PARTIALLD='ld -r -melf_i386' \
$configure_flags
;;
*)
cd ..
if command -v pdflatex &>/dev/null ; then
echo Ensuring that all library documentation compiles
- make -C ocamldoc html_doc pdf_doc texi_doc
+ $MAKE -C ocamldoc html_doc pdf_doc texi_doc
fi
$MAKE install
+ if command -v hevea &>/dev/null ; then
+ echo Ensuring that the manual compiles
+ # These steps rely on the compiler being installed and in PATH
+ $MAKE -C manual/manual/html_processing duniverse
+ $MAKE -C manual web
+ fi
if fgrep 'SUPPORTS_SHARED_LIBRARIES=true' Makefile.config &>/dev/null ; then
echo Check the code examples in the manual
$MAKE manual-pregen
$MAKE -C manual clean
# check that the `distclean` target definitely cleans the tree
$MAKE distclean
+ $MAKE -C manual distclean
# Check the working tree is clean
test -z "$(git status --porcelain)"
# Check that there are no ignored files
check-typo)
set +x
CheckTypo;;
+check-depend)
+ CheckSyncStdlibDocs
+ CheckDepend;;
*) echo unknown CI kind
exit 1
;;
| Const_base(Const_int32 i) -> printf "%ldl" i
| Const_base(Const_nativeint i) -> printf "%ndn" i
| Const_base(Const_int64 i) -> printf "%LdL" i
- | Const_pointer n -> printf "%da" n
| Const_block(tag, args) ->
printf "<%d>" tag;
begin match args with
opGRAB, Uint;
opCLOSURE, Uint_Disp;
opCLOSUREREC, Closurerec;
- opOFFSETCLOSUREM2, Nothing;
+ opOFFSETCLOSUREM3, Nothing;
opOFFSETCLOSURE0, Nothing;
- opOFFSETCLOSURE2, Nothing;
+ opOFFSETCLOSURE3, Nothing;
opOFFSETCLOSURE, Sint; (* was Uint *)
- opPUSHOFFSETCLOSUREM2, Nothing;
+ opPUSHOFFSETCLOSUREM3, Nothing;
opPUSHOFFSETCLOSURE0, Nothing;
- opPUSHOFFSETCLOSURE2, Nothing;
+ opPUSHOFFSETCLOSURE3, Nothing;
opPUSHOFFSETCLOSURE, Sint; (* was Nothing *)
opGETGLOBAL, Getglobal;
opPUSHGETGLOBAL, Getglobal;
+++ /dev/null
-#!/bin/sh
-
-#**************************************************************************
-#* *
-#* OCaml *
-#* *
-#* Damien Doligez, projet Moscova, INRIA Rocquencourt *
-#* *
-#* Copyright 2003 Institut National de Recherche en Informatique et *
-#* en Automatique. *
-#* *
-#* All rights reserved. This file is distributed under the terms of *
-#* the GNU Lesser General Public License version 2.1, with the *
-#* special exception on linking described in the file LICENSE. *
-#* *
-#**************************************************************************
-
-cd package-macosx
-rm -rf ocaml.pkg ocaml-rw.dmg
-
-VERSION=`sed -e 1q ../VERSION`
-VERSION_MAJOR=`sed -n -e '1s/^\([0-9]*\)\..*/\1/p' ../VERSION`
-VERSION_MINOR=`sed -n -e '1s/^[0-9]*\.\([0-9]*\)[.+].*/\1/p' ../VERSION`
-
-cat >Description.plist <<EOF
- <?xml version="1.0" encoding="UTF-8"?>
- <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN"
- "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
- <plist version="1.0">
- <dict>
- <key>IFPkgDescriptionDeleteWarning</key>
- <string></string>
- <key>IFPkgDescriptionDescription</key>
- <string>The OCaml compiler and tools</string>
- <key>IFPkgDescriptionTitle</key>
- <string>OCaml</string>
- <key>IFPkgDescriptionVersion</key>
- <string>${VERSION}</string>
- </dict>
- </plist>
-EOF
-
-cat >Info.plist <<EOF
-<?xml version="1.0" encoding="UTF-8"?>
-<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN"
- "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
-<plist version="1.0">
-<dict>
- <key>CFBundleGetInfoString</key>
- <string>OCaml ${VERSION}</string>
- <key>CFBundleIdentifier</key>
- <string>fr.inria.ocaml</string>
- <key>CFBundleName</key>
- <string>OCaml</string>
- <key>CFBundleShortVersionString</key>
- <string>${VERSION}</string>
- <key>IFMajorVersion</key>
- <integer>${VERSION_MAJOR}</integer>
- <key>IFMinorVersion</key>
- <integer>${VERSION_MINOR}</integer>
- <key>IFPkgFlagAllowBackRev</key>
- <true/>
- <key>IFPkgFlagAuthorizationAction</key>
- <string>AdminAuthorization</string>
- <key>IFPkgFlagDefaultLocation</key>
- <string>/usr/local</string>
- <key>IFPkgFlagInstallFat</key>
- <false/>
- <key>IFPkgFlagIsRequired</key>
- <false/>
- <key>IFPkgFlagRelocatable</key>
- <false/>
- <key>IFPkgFlagRestartAction</key>
- <string>NoRestart</string>
- <key>IFPkgFlagRootVolumeOnly</key>
- <true/>
- <key>IFPkgFlagUpdateInstalledLanguages</key>
- <false/>
- <key>IFPkgFormatVersion</key>
- <real>0.10000000149011612</real>
-</dict>
-</plist>
-EOF
-
-mkdir -p resources
-
-# stop here -> |
-cat >resources/ReadMe.txt <<EOF
-This package installs OCaml version ${VERSION}.
-You need Mac OS X 10.11.x (El Capitan) or later, with the
-XCode tools installed (v7.3 or later) and the command-line
-tools for XCode.
-
-Files will be installed in the following directories:
-
-/usr/local/bin - command-line executables
-/usr/local/lib/ocaml - library and support files
-/usr/local/man - manual pages
-
-Note that this package installs only command-line
-tools and does not include any GUI application.
-EOF
-
-chmod -R g-w root
-sudo chown -R root:wheel root
-
-# HOW TO INSTALL PackageMaker:
-# Get PackageMaker.app from
-# https://developer.apple.com/downloads/index.action?name=Auxiliary
-# It's in the "Auxiliary Tools for Xcode" download.
-# Copy it to /Applications/.
-/Applications/PackageMaker.app/Contents/MacOS/PackageMaker \
- -build -p "`pwd`/ocaml.pkg" -f "`pwd`/root" -i "`pwd`/Info.plist" \
- -d "`pwd`/Description.plist" -r "`pwd`/resources"
-
-size=`du -s ocaml.pkg | cut -f 1`
-size=`expr $size + 8192`
-
-hdiutil create -sectors $size ocaml-rw.dmg
-name=`hdid -nomount ocaml-rw.dmg | grep Apple_HFS | cut -d ' ' -f 1`
-volname="OCaml ${VERSION}"
-newfs_hfs -v "$volname" $name
-hdiutil detach $name
-
-name=`hdid ocaml-rw.dmg | grep Apple_HFS | cut -d ' ' -f 1`
-if test -d "/Volumes/$volname"; then
- ditto -rsrcFork ocaml.pkg "/Volumes/$volname/ocaml.pkg"
- cp resources/ReadMe.txt "/Volumes/$volname/"
-else
- echo "Unable to mount the disk image as \"/Volumes/$volname\"" >&2
- exit 3
-fi
-open "/Volumes/$volname"
-sleep 2
-hdiutil detach $name
-
-rm -rf "ocaml-${VERSION}.dmg"
-hdiutil convert ocaml-rw.dmg -format UDZO -o "ocaml-${VERSION}.dmg"
+++ /dev/null
-#!/bin/sh
-
-#**************************************************************************
-#* *
-#* OCaml *
-#* *
-#* Gabriel Scherer, projet Parsifal, INRIA Saclay *
-#* *
-#* Copyright 2018 Institut National de Recherche en Informatique et *
-#* en Automatique. *
-#* *
-#* All rights reserved. This file is distributed under the terms of *
-#* the GNU Lesser General Public License version 2.1, with the *
-#* special exception on linking described in the file LICENSE. *
-#* *
-#**************************************************************************
-
-# This script performs a series of transformation on standard input to
-# turn ASCII references into Markdown-format links:
-# - GPR#NNNN links to Github
-# - MPR#NNNN and PR#NNNN link to Mantis
-# - (Changes#VERSION) link to the Changes file
-
-# It was only tested with GNU sed. Sorry!
-
-GITHUB=https://github.com/ocaml/ocaml
-MANTIS=https://caml.inria.fr/mantis
-
-cat \
-| sed "s,GPR#\\([0-9]*\\),[GPR~#~\\1]($GITHUB/pull/\\1),g"\
-| sed "s,MPR#\\([0-9]*\\),[PR~#~\\1]($MANTIS/view.php?id=\\1),g"\
-| sed "s,PR#\\([0-9]*\\),[PR~#~\\1]($MANTIS/view.php?id=\\1),g"\
-| sed "s,(Changes#\\(.*\\)),[Changes file for \\1]($GITHUB/blob/\\1/Changes),g"\
-| sed "s,PR~#~,PR#,g" \
toc
let find_dyn_offset filename =
- let helper = Filename.concat Config.standard_library "objinfo_helper" in
- let tempfile = Filename.temp_file "objinfo" ".out" in
- match
- Fun.protect
- ~finally:(fun () -> remove_file tempfile)
- (fun () ->
- let rc =
- Sys.command
- (Filename.quote_command helper ~stdout:tempfile [filename])
- in
- if rc <> 0 then failwith "cannot read";
- let tc = Scanf.Scanning.from_file tempfile in
- Fun.protect
- ~finally:(fun () -> Scanf.Scanning.close_in tc)
- (fun () ->
- Scanf.bscanf tc "%Ld" (fun x -> x)))
- with
- | offset -> Some offset
- | exception (Failure _ | Sys_error _) -> None
+ match Binutils.read filename with
+ | Ok t ->
+ Binutils.symbol_offset t "caml_plugin_header"
+ | Error _ ->
+ None
let exit_err msg = print_endline msg; exit 2
let exit_errf fmt = Printf.ksprintf exit_err fmt
+++ /dev/null
-/**************************************************************************/
-/* */
-/* OCaml */
-/* */
-/* Mehdi Dogguy, PPS laboratory, University Paris Diderot */
-/* */
-/* Copyright 2010 Mehdi Dogguy */
-/* */
-/* All rights reserved. This file is distributed 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/s.h"
-#include <stdio.h>
-
-#ifdef HAS_LIBBFD
-#include <stdlib.h>
-#include <string.h>
-#include <stdarg.h>
-
-// PACKAGE: protect against binutils change
-// https://sourceware.org/bugzilla/show_bug.cgi?id=14243
-#define PACKAGE "ocamlobjinfo"
-#include <bfd.h>
-#undef PACKAGE
-
-#define plugin_header_sym (symbol_prefix "caml_plugin_header")
-
-/* We need to refer to a few functions of the BFD library that are */
-/* actually defined as macros. We thus define equivalent */
-/* functions below */
-
-long get_static_symtab_upper_bound(bfd *fd)
-{
- return bfd_get_symtab_upper_bound(fd);
-}
-
-long get_dynamic_symtab_upper_bound(bfd *fd)
-{
- return bfd_get_dynamic_symtab_upper_bound(fd);
-}
-
-long canonicalize_static_symtab(bfd * fd, asymbol **symbolTable)
-{
- return bfd_canonicalize_symtab(fd, symbolTable);
-}
-
-long canonicalize_dynamic_symtab(bfd * fd, asymbol **symbolTable)
-{
- return bfd_canonicalize_dynamic_symtab(fd, symbolTable);
-}
-
-typedef struct {
- long (*get_upper_bound)(bfd *);
- long (*canonicalize)(bfd *, asymbol **);
-} symTable_ops;
-
-symTable_ops staticSymTable_ops = {
- &get_static_symtab_upper_bound,
- &canonicalize_static_symtab
-};
-
-symTable_ops dynamicSymTable_ops = {
- &get_dynamic_symtab_upper_bound,
- &canonicalize_dynamic_symtab
-};
-
-/* Print an error message and exit */
-static void error(bfd *fd, char *msg, ...)
-{
- va_list ap;
- va_start(ap, msg);
- vfprintf (stderr, msg, ap);
- va_end(ap);
- fprintf(stderr, "\n");
- if (fd!=NULL) bfd_close(fd);
- exit(2);
-}
-
-/* Look for plugin_header_sym in the specified symbol table */
-/* Return its address, -1 if not found */
-long lookup(bfd* fd, symTable_ops *ops)
-{
- long st_size;
- asymbol ** symbol_table;
- long sym_count, i;
-
- st_size = ops->get_upper_bound (fd);
- if (st_size <= 0) return -1;
-
- symbol_table = malloc(st_size);
- if (! symbol_table)
- error(fd, "Error: out of memory");
-
- sym_count = ops->canonicalize (fd, symbol_table);
-
- for (i = 0; i < sym_count; i++) {
- if (strcmp(symbol_table[i]->name, plugin_header_sym) == 0)
- return symbol_table[i]->value;
- }
- return -1;
-}
-
-int main(int argc, char ** argv)
-{
- bfd *fd;
- asection *sec;
- file_ptr offset;
- long value;
-
- if (argc != 2)
- error(NULL, "Usage: objinfo_helper <dynamic library>");
-
- fd = bfd_openr(argv[1], "default");
- if (!fd)
- error(NULL, "Error opening file %s", argv[1]);
- if (! bfd_check_format (fd, bfd_object))
- error(fd, "Error: wrong format");
-
- sec = bfd_get_section_by_name(fd, ".data");
- if (! sec)
- error(fd, "Error: section .data not found");
-
- offset = sec->filepos;
-
- value = lookup(fd, &dynamicSymTable_ops);
-
- if (value == -1)
- value = lookup(fd, &staticSymTable_ops);
- bfd_close(fd);
-
- if (value == -1)
- error(NULL, "Error: missing symbol %s", plugin_header_sym);
-
- printf("%ld\n", (long) offset + value);
-}
-
-#else
-
-int main(int argc, char ** argv)
-{
- fprintf(stderr,"BFD library unavailable, cannot print info on .cmxs files\n");
- return 2;
-}
-
-#endif
+++ /dev/null
-#!/usr/bin/env bash
-
-#**************************************************************************
-#* *
-#* OCaml *
-#* *
-#* Damien Doligez, projet Cristal, INRIA Rocquencourt *
-#* *
-#* Copyright 2005 Institut National de Recherche en Informatique et *
-#* en Automatique. *
-#* *
-#* All rights reserved. This file is distributed under the terms of *
-#* the GNU Lesser General Public License version 2.1, with the *
-#* special exception on linking described in the file LICENSE. *
-#* *
-#**************************************************************************
-
-TMP="${TMPDIR=/tmp}"
-TEMP="${TMP}"/ocaml-objcopy-$$.o
-UNDEF="${TMP}"/ocaml-objcopy-$$.sym
-
-usage () {
- echo "usage: objcopy {--redefine-sym <old>=<new>} file.o" >&2
- exit 2
-}
-
-: > "$UNDEF"
-
-while : ; do
- case $# in
- 0) break;;
- *) case $1 in
- --redefine-sym)
- case $2 in
- *=*) ALIAS="$ALIAS -i${2#*=}:${2%%=*}"
- echo ${2%%=*} >>"$UNDEF"
- ;;
- *) usage;;
- esac
- shift 2
- ;;
- -*) usage;;
- *) case $FILE in
- "") FILE=$1; shift;;
- *) usage;;
- esac;;
- esac;;
- esac
-done
-
-ld -o "$TEMP" -r $ALIAS "$FILE"
-ld -o "$FILE" -r -unexported_symbols_list "$UNDEF" "$TEMP"
-
-rm -f "$TEMP" "$UNDEF"
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Fabrice Le Fessant, INRIA Saclay *)
+(* *)
+(* Copyright 2012 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+let gen_annot = ref false
+let gen_ml = ref false
+let print_info_arg = ref false
+let target_filename = ref None
+let save_cmt_info = ref false
+
+let arg_list = Arg.align [
+ "-o", Arg.String (fun s -> target_filename := Some s),
+ "<file> Dump to file <file> (or stdout if -)";
+ "-annot", Arg.Set gen_annot,
+ " Generate the corresponding .annot file";
+ "-save-cmt-info", Arg.Set save_cmt_info,
+ " Encapsulate additional cmt information in annotations";
+ "-src", Arg.Set gen_ml,
+ " Convert .cmt or .cmti back to source code (without comments)";
+ "-info", Arg.Set print_info_arg, " : print information on the file";
+ "-args", Arg.Expand Arg.read_arg,
+ "<file> Read additional newline separated command line arguments \n\
+ \ from <file>";
+ "-args0", Arg.Expand Arg.read_arg0,
+ "<file> Read additional NUL separated command line arguments from \n\
+ \ <file>";
+ "-I", Arg.String (fun s ->
+ Clflags.include_dirs := s :: !Clflags.include_dirs),
+ "<dir> Add <dir> to the list of include directories";
+ ]
+
+let arg_usage =
+ "ocamlcmt [OPTIONS] FILE.cmt : read FILE.cmt and print related information"
+
+let dummy_crc = String.make 32 '-'
+
+let print_info cmt =
+ let oc = match !target_filename with
+ | None -> stdout
+ | Some filename -> open_out filename
+ in
+ let open Cmt_format in
+ Printf.fprintf oc "module name: %s\n" cmt.cmt_modname;
+ begin match cmt.cmt_annots with
+ Packed (_, list) ->
+ Printf.fprintf oc "pack: %s\n" (String.concat " " list)
+ | Implementation _ -> Printf.fprintf oc "kind: implementation\n"
+ | Interface _ -> Printf.fprintf oc "kind: interface\n"
+ | Partial_implementation _ ->
+ Printf.fprintf oc "kind: implementation with errors\n"
+ | Partial_interface _ -> Printf.fprintf oc "kind: interface with errors\n"
+ end;
+ Printf.fprintf oc "command: %s\n"
+ (String.concat " " (Array.to_list cmt.cmt_args));
+ begin match cmt.cmt_sourcefile with
+ None -> ()
+ | Some name ->
+ Printf.fprintf oc "sourcefile: %s\n" name;
+ end;
+ Printf.fprintf oc "build directory: %s\n" cmt.cmt_builddir;
+ List.iter (Printf.fprintf oc "load path: %s\n%!") cmt.cmt_loadpath;
+ begin
+ match cmt.cmt_source_digest with
+ None -> ()
+ | Some digest ->
+ Printf.fprintf oc "source digest: %s\n" (Digest.to_hex digest);
+ end;
+ begin
+ match cmt.cmt_interface_digest with
+ None -> ()
+ | Some digest ->
+ Printf.fprintf oc "interface digest: %s\n" (Digest.to_hex digest);
+ end;
+ List.iter (fun (name, crco) ->
+ let crc =
+ match crco with
+ None -> dummy_crc
+ | Some crc -> Digest.to_hex crc
+ in
+ Printf.fprintf oc "import: %s %s\n" name crc;
+ ) (List.sort compare cmt.cmt_imports);
+ Printf.fprintf oc "%!";
+ begin match !target_filename with
+ | None -> ()
+ | Some _ -> close_out oc
+ end;
+ ()
+
+let generate_ml target_filename filename cmt =
+ let (printer, ext) =
+ match cmt.Cmt_format.cmt_annots with
+ | Cmt_format.Implementation typedtree ->
+ (fun ppf -> Pprintast.structure ppf
+ (Untypeast.untype_structure typedtree)),
+ ".ml"
+ | Cmt_format.Interface typedtree ->
+ (fun ppf -> Pprintast.signature ppf
+ (Untypeast.untype_signature typedtree)),
+ ".mli"
+ | _ ->
+ Printf.fprintf stderr "File was generated with an error\n%!";
+ exit 2
+ in
+ let target_filename = match target_filename with
+ None -> Some (filename ^ ext)
+ | Some "-" -> None
+ | Some _ -> target_filename
+ in
+ let oc = match target_filename with
+ None -> None
+ | Some filename -> Some (open_out filename) in
+ let ppf = match oc with
+ None -> Format.std_formatter
+ | Some oc -> Format.formatter_of_out_channel oc in
+ printer ppf;
+ Format.pp_print_flush ppf ();
+ match oc with
+ None -> flush stdout
+ | Some oc -> close_out oc
+
+(* Save cmt information as faked annotations, attached to
+ Location.none, on top of the .annot file. Only when -save-cmt-info is
+ provided to ocaml_cmt.
+*)
+let record_cmt_info cmt =
+ let location_none = {
+ Location.none with Location.loc_ghost = false }
+ in
+ let location_file file = {
+ Location.none with
+ Location.loc_start = {
+ Location.none.Location.loc_start with
+ Lexing.pos_fname = file }}
+ in
+ let record_info name value =
+ let ident = Printf.sprintf ".%s" name in
+ Stypes.record (Stypes.An_ident (location_none, ident,
+ Annot.Idef (location_file value)))
+ in
+ let open Cmt_format in
+ List.iter (fun dir -> record_info "include" dir) cmt.cmt_loadpath;
+ record_info "chdir" cmt.cmt_builddir;
+ (match cmt.cmt_sourcefile with
+ None -> () | Some file -> record_info "source" file)
+
+let main () =
+ Clflags.annotations := true;
+
+ Arg.parse_expand arg_list (fun filename ->
+ if
+ Filename.check_suffix filename ".cmt" ||
+ Filename.check_suffix filename ".cmti"
+ then begin
+ let open Cmt_format in
+ Compmisc.init_path ();
+ let cmt = read_cmt filename in
+ if !gen_annot then begin
+ if !save_cmt_info then record_cmt_info cmt;
+ let target_filename =
+ match !target_filename with
+ | None -> Some (filename ^ ".annot")
+ | Some "-" -> None
+ | Some _ as x -> x
+ in
+ Envaux.reset_cache ();
+ List.iter Load_path.add_dir cmt.cmt_loadpath;
+ Cmt2annot.gen_annot target_filename
+ ~sourcefile:cmt.cmt_sourcefile
+ ~use_summaries:cmt.cmt_use_summaries
+ cmt.cmt_annots
+ end;
+ if !gen_ml then generate_ml !target_filename filename cmt;
+ if !print_info_arg || not (!gen_ml || !gen_annot) then print_info cmt;
+ end else begin
+ Printf.fprintf stderr
+ "Error: the file's extension must be .cmt or .cmti.\n%!";
+ Arg.usage arg_list arg_usage
+ end
+ ) arg_usage
+
+
+let () =
+ try
+ main ()
+ with x ->
+ Printf.eprintf "Exception in main ()\n%!";
+ Location.report_exception Format.err_formatter x;
+ Format.fprintf Format.err_formatter "@.";
+ exit 2
:: ("-p", Arg.String add_profarg, "[afilmt] Same as option -P")
:: Main_args.options_with_command_line_syntax Options.list rev_compargs
in
-Arg.parse_expand optlist anon usage;
+begin try
+ Arg.parse_expand optlist anon usage
+with Compenv.Exit_with_status n -> exit n
+end;
if !with_impl && !with_intf then begin
fprintf stderr "ocamlcp cannot deal with both \"-impl\" and \"-intf\"\n";
fprintf stderr "please compile interfaces and implementations separately\n";
cmd.exe has special quoting rules (see 'cmd.exe /?' for details).
Short version: if the string passed to cmd.exe starts with '"',
the first and last '"' are removed *)
- let ocamlc,extra_quote =
- if Sys.win32 then "ocamlc.exe","\"" else "ocamlc",""
- in
+ let ocamlc = "ocamlc" ^ Config.ext_exe in
+ let extra_quote = if Sys.win32 then "\"" else "" in
let ocamlc = Filename.(quote (concat (dirname ocamlmktop) ocamlc)) in
let cmdline =
extra_quote ^ ocamlc ^ " -I +compiler-libs -linkall ocamlcommon.cma " ^
\032 t try ... with")
:: Main_args.options_with_command_line_syntax Options.list rev_compargs
in
-Arg.parse_expand optlist anon usage;
+begin try
+ Arg.parse_expand optlist anon usage
+with Compenv.Exit_with_status n -> exit n
+end;
if !with_impl && !with_intf then begin
fprintf stderr "ocamloptp cannot deal with both \"-impl\" and \"-intf\"\n";
fprintf stderr "please compile interfaces and implementations separately\n";
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Fabrice Le Fessant, INRIA Saclay *)
-(* *)
-(* Copyright 2012 Institut National de Recherche en Informatique et *)
-(* en Automatique. *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-let gen_annot = ref false
-let gen_ml = ref false
-let print_info_arg = ref false
-let target_filename = ref None
-let save_cmt_info = ref false
-
-let arg_list = Arg.align [
- "-o", Arg.String (fun s -> target_filename := Some s),
- "<file> Dump to file <file> (or stdout if -)";
- "-annot", Arg.Set gen_annot,
- " Generate the corresponding .annot file";
- "-save-cmt-info", Arg.Set save_cmt_info,
- " Encapsulate additional cmt information in annotations";
- "-src", Arg.Set gen_ml,
- " Convert .cmt or .cmti back to source code (without comments)";
- "-info", Arg.Set print_info_arg, " : print information on the file";
- "-args", Arg.Expand Arg.read_arg,
- "<file> Read additional newline separated command line arguments \n\
- \ from <file>";
- "-args0", Arg.Expand Arg.read_arg0,
- "<file> Read additional NUL separated command line arguments from \n\
- \ <file>";
- "-I", Arg.String (fun s ->
- Clflags.include_dirs := s :: !Clflags.include_dirs),
- "<dir> Add <dir> to the list of include directories";
- ]
-
-let arg_usage =
- "read_cmt [OPTIONS] FILE.cmt : read FILE.cmt and print related information"
-
-let dummy_crc = String.make 32 '-'
-
-let print_info cmt =
- let oc = match !target_filename with
- | None -> stdout
- | Some filename -> open_out filename
- in
- let open Cmt_format in
- Printf.fprintf oc "module name: %s\n" cmt.cmt_modname;
- begin match cmt.cmt_annots with
- Packed (_, list) ->
- Printf.fprintf oc "pack: %s\n" (String.concat " " list)
- | Implementation _ -> Printf.fprintf oc "kind: implementation\n"
- | Interface _ -> Printf.fprintf oc "kind: interface\n"
- | Partial_implementation _ ->
- Printf.fprintf oc "kind: implementation with errors\n"
- | Partial_interface _ -> Printf.fprintf oc "kind: interface with errors\n"
- end;
- Printf.fprintf oc "command: %s\n"
- (String.concat " " (Array.to_list cmt.cmt_args));
- begin match cmt.cmt_sourcefile with
- None -> ()
- | Some name ->
- Printf.fprintf oc "sourcefile: %s\n" name;
- end;
- Printf.fprintf oc "build directory: %s\n" cmt.cmt_builddir;
- List.iter (Printf.fprintf oc "load path: %s\n%!") cmt.cmt_loadpath;
- begin
- match cmt.cmt_source_digest with
- None -> ()
- | Some digest ->
- Printf.fprintf oc "source digest: %s\n" (Digest.to_hex digest);
- end;
- begin
- match cmt.cmt_interface_digest with
- None -> ()
- | Some digest ->
- Printf.fprintf oc "interface digest: %s\n" (Digest.to_hex digest);
- end;
- List.iter (fun (name, crco) ->
- let crc =
- match crco with
- None -> dummy_crc
- | Some crc -> Digest.to_hex crc
- in
- Printf.fprintf oc "import: %s %s\n" name crc;
- ) (List.sort compare cmt.cmt_imports);
- Printf.fprintf oc "%!";
- begin match !target_filename with
- | None -> ()
- | Some _ -> close_out oc
- end;
- ()
-
-let generate_ml target_filename filename cmt =
- let (printer, ext) =
- match cmt.Cmt_format.cmt_annots with
- | Cmt_format.Implementation typedtree ->
- (fun ppf -> Pprintast.structure ppf
- (Untypeast.untype_structure typedtree)),
- ".ml"
- | Cmt_format.Interface typedtree ->
- (fun ppf -> Pprintast.signature ppf
- (Untypeast.untype_signature typedtree)),
- ".mli"
- | _ ->
- Printf.fprintf stderr "File was generated with an error\n%!";
- exit 2
- in
- let target_filename = match target_filename with
- None -> Some (filename ^ ext)
- | Some "-" -> None
- | Some _ -> target_filename
- in
- let oc = match target_filename with
- None -> None
- | Some filename -> Some (open_out filename) in
- let ppf = match oc with
- None -> Format.std_formatter
- | Some oc -> Format.formatter_of_out_channel oc in
- printer ppf;
- Format.pp_print_flush ppf ();
- match oc with
- None -> flush stdout
- | Some oc -> close_out oc
-
-(* Save cmt information as faked annotations, attached to
- Location.none, on top of the .annot file. Only when -save-cmt-info is
- provided to ocaml_cmt.
-*)
-let record_cmt_info cmt =
- let location_none = {
- Location.none with Location.loc_ghost = false }
- in
- let location_file file = {
- Location.none with
- Location.loc_start = {
- Location.none.Location.loc_start with
- Lexing.pos_fname = file }}
- in
- let record_info name value =
- let ident = Printf.sprintf ".%s" name in
- Stypes.record (Stypes.An_ident (location_none, ident,
- Annot.Idef (location_file value)))
- in
- let open Cmt_format in
- (* record in reverse order to get them in correct order... *)
- List.iter (fun dir -> record_info "include" dir) (List.rev cmt.cmt_loadpath);
- record_info "chdir" cmt.cmt_builddir;
- (match cmt.cmt_sourcefile with
- None -> () | Some file -> record_info "source" file)
-
-let main () =
- Clflags.annotations := true;
-
- Arg.parse_expand arg_list (fun filename ->
- if
- Filename.check_suffix filename ".cmt" ||
- Filename.check_suffix filename ".cmti"
- then begin
- let open Cmt_format in
- Compmisc.init_path ();
- let cmt = read_cmt filename in
- if !gen_annot then begin
- if !save_cmt_info then record_cmt_info cmt;
- let target_filename =
- match !target_filename with
- | None -> Some (filename ^ ".annot")
- | Some "-" -> None
- | Some _ as x -> x
- in
- Envaux.reset_cache ();
- List.iter Load_path.add_dir (List.rev cmt.cmt_loadpath);
- Cmt2annot.gen_annot target_filename
- ~sourcefile:cmt.cmt_sourcefile
- ~use_summaries:cmt.cmt_use_summaries
- cmt.cmt_annots
- end;
- if !gen_ml then generate_ml !target_filename filename cmt;
- if !print_info_arg || not (!gen_ml || !gen_annot) then print_info cmt;
- end else begin
- Printf.fprintf stderr
- "Error: the file's extension must be .cmt or .cmti.\n%!";
- Arg.usage arg_list arg_usage
- end
- ) arg_usage
-
-
-let () =
- try
- main ()
- with x ->
- Printf.eprintf "Exception in main ()\n%!";
- Location.report_exception Format.err_formatter x;
- Format.fprintf Format.err_formatter "@.";
- exit 2
+++ /dev/null
-These are informal notes on how to do an OCaml release.
-
-Following these steps requires commit right in the OCaml repository,
-as well as SSH access to the inria.fr file servers hosting the
-distribution archives and manual.
-
-We are not fully confident that those steps are correct, feel free to
-check with other release managers in case of doubt.
-
-Note: we say that a new release is a "testing release" if it is a Beta
-version or Release Candidate. Otherwise, we call it a "production
-release".
-
-
-## A few days in advance
-
-Send a mail on caml-devel to warn Gabriel (to make a pass on Changes;
-see the "Changes curation" appendix for more details) and the
-OCamlLabs folks (for OPAM testing).
-
-## 0: release environment setup
-
-```
-rm -f /tmp/env-$USER.sh
-cat >/tmp/env-$USER.sh <<EOF
-
-export MAJOR=4
-export MINOR=08
-export BUGFIX=0
-export PLUSEXT=
-
-export WORKTREE=~/o/\$MAJOR.\$MINOR
- # must be the git worktree for the branch you are releasing
-
-export BRANCH=\$MAJOR.\$MINOR
-export VERSION=\$MAJOR.\$MINOR.\$BUGFIX\$PLUSEXT
-
-export REPO=http://github.com/ocaml/ocaml
-
-# these values are specific to caml.inria's host setup
-# they are defined in the release manager's .bashrc file
-export ARCHIVE_HOST="$OCAML_RELEASE_ARCHIVE_HOST"
-export ARCHIVE_PATH="$OCAML_RELEASE_ARCHIVE_PATH"
-export WEB_HOST="$OCAML_RELEASE_WEB_HOST"
-export WEB_PATH="$OCAML_RELEASE_WEB_PATH"
-
-export DIST="\$ARCHIVE_PATH/ocaml/ocaml-\$MAJOR.\$MINOR"
-EOF
-source /tmp/env-$USER.sh
-echo $VERSION
-```
-
-
-## 1: check repository state
-
-```
-cd $WORKTREE
-git status # check that the local repo is in a clean state
-git pull
-```
-
-## 2: magic numbers
-
-If you are about to do a major release, you should check that the
-magic numbers have been updated since the last major release. It is
-preferable to do this just before the first testing release for this
-major version, typically the first beta.
-
-See the HACKING file of `utils/` for documentation on how to bump the
-magic numbers.
-
-## 3: build, refresh dependencies, sanity checks
-
-```
-make distclean
-git clean -n -d -f -x # Check that "make distclean" removed everything
-
-INSTDIR=/tmp/ocaml-${VERSION}
-rm -rf ${INSTDIR}
-./configure -prefix ${INSTDIR}
-
-make -j5
-make alldepend
-
-# check that .depend files have no absolute path in them
-find . -name .depend | xargs grep ' /'
- # must have empty output
-
-make install
-./tools/check-symbol-names runtime/*.a
- # must have empty output and return 0
-```
-
-
-## 4: tests
-
-```
-make tests
-```
-
-
-## 5: build, tag and push the new release
-
-```
-# at this point, the VERSION file contains N+devD
-# increment it into N+dev(D+1); for example,
-# 4.07.0+dev8-2018-06-19 => 4.07.0+dev9-2018-06-26
-# for production releases: check and change the Changes header
-# (remove "next version" and add a date)
-make -B configure
-git commit -a -m "last commit before tagging $VERSION"
-
-# update VERSION with the new release; for example,
-# 4.07.0+dev9-2018-06-26 => 4.07.0+rc2
-# Update ocaml-variants.opam with new version.
-# Update \year in manual/manual/macros.hva
-rm -r autom4te.cache
-make -B configure
-make coreboot -j5
-make coreboot -j5 # must say "Fixpoint reached, bootstrap succeeded."
-git commit -m "release $VERSION" -a
-git tag -m "release $VERSION" $VERSION
-
-# for production releases, change the VERSION file into (N+1)+dev0; for example,
-# 4.08.0 => 4.08.1+dev0
-# for testing candidates, use N+dev(D+2) instead; for example,
-# 4.07.0+rc2 => 4.07.0+dev10-2018-06-26
-# Revert ocaml-variants.opam to its "trunk" version.
-rm -r autom4te.cache
-make -B configure
-git commit -m "increment version number after tagging $VERSION" VERSION configure ocaml-variants.opam
-git push
-git push --tags
-```
-
-## 5-bis: Alternative for branching
-
-This needs to be more tested, tread with care.
-```
-# at this point, the VERSION file contains N+devD
-# increment it into N+dev(D+1); for example,
-# 4.07.0+dev0-2018-06-19 => 4.07.0+dev1-2018-06-26
-# Rename the "Working version" header in Changes
-# to "OCaml $BRANCH"
-make -B configure
-git commit -a -m "last commit before branching $BRANCH"
-git branch $BRANCH
-
-# update VERSION with the new future branch,
-# 4.07.0+dev1-2018-06-26 => 4.08.0+dev0-2018-06-30
-# Update ocaml-variants.opam with new version.
-make -B configure
-# Add a "Working version" section" to Changes
-# Add common subsections in Changes, see Changelog.
-git commit -m "first commit after branching $VERSION" -a
-git push
-
-# Switch to the new branch
-git checkout $VERSION
-# increment VERSION, for instance
-# 4.07.0+dev1-2018-06-26 => 4.07.0+dev2-2018-06-30
-make -B configure
-git commit -m "first commit on branch $VERSION" -a
-git push $VERSION
-```
-
-Adjust github branch settings:
-
-Go to
- https://github.com/ocaml/ocaml/settings/branches
-and add a rule for protecting the new branch
-(copy the rights from the previous version)
-
-## 5.1: create the release on github (only for a production release)
-
-open https://github.com/ocaml/ocaml/releases
-# and click "Draft a new release"
-# for a minor release, the description is:
- Bug fixes. See [detailed list of changes](https://github.com/ocaml/ocaml/blob/$MAJOR.$MINOR/Changes).
-
-## 5.3: Inria CI (for a new release branch)
-
-Add the new release branch to the Inria CI list.
-Remove the oldest branch from this list.
-
-## 5.4 new badge in README.adoc (for a new release branch)
-
-Add a badge for the new branch in README.adoc.
-Remove any badge that tracks a version older than Debian stable.
-
-
-## 6: create OPAM packages
-
-Create ocaml-variants packages for the new version, copying the particular
-switch configuration choices from the previous version.
-
-Do not forget to add/update the checksum field for the tarballs in the
-"url" section of the opam files. Use opam-lint before sending the pull
-request.
-
-## 6.1 Update OPAM dev packages after branching
-
-Create a new ocaml/ocaml.$NEXT/opam file.
-Copy the opam dev files from ocaml-variants/ocaml-variants.$VERSION+trunk*
-into ocaml-variants/ocaml-variants.$NEXT+trunk+* .
-Update the version in those opam files.
-
-Update the synopsis and "src" field in the opam $VERSION packages.
-The "src" field should point to
- src: "https://github.com/ocaml/ocaml/archive/$VERSION.tar.gz"
-The synopsis should be "latest $VERSION development(,...)".
-
-## 7: build the release archives
-
-```
-cd $WORKTREE
-TMPDIR=/tmp/ocaml-release
-git checkout $VERSION
-git checkout-index -a -f --prefix=$TMPDIR/ocaml-$VERSION/
-cd $TMPDIR
-gtar -c --owner 0 --group 0 -f ocaml-$VERSION.tar ocaml-$VERSION
-gzip -9 <ocaml-$VERSION.tar >ocaml-$VERSION.tar.gz
-xz <ocaml-$VERSION.tar >ocaml-$VERSION.tar.xz
-```
-
-
-## 8: upload the archives and compute checksums
-
-For the first beta of a major version, create the distribution directory on
-the server:
-```
-ssh $ARCHIVE_HOST "mkdir -p $DIST"
-```
-
-Upload the archives:
-```
-scp ocaml-$VERSION.tar.{xz,gz} $ARCHIVE_HOST:$DIST
-```
-
-To update the checksum files on the remote host, we first upload the
-release environment.
-(note: this assumes the user name is the same on the two machines)
-
-```
-scp /tmp/env-$USER.sh $ARCHIVE_HOST:/tmp/env-$USER.sh
-```
-
-and then login there to update the checksums (MD5SUM, SHA512SUM)
-
-```
-ssh $ARCHIVE_HOST
-source /tmp/env-$USER.sh
-cd $DIST
-
-cp MD5SUM MD5SUM.old
-md5sum ocaml-$VERSION.tar.{xz,gz} > new-md5s
-# check new-md5s to ensure that they look right, and then
-cat new-md5s >> MD5SUM
-# if everything worked well,
-rm MD5SUM.old new-md5s
-
-# same thing for SHA512
-cp SHA512SUM SHA512SUM.old
-sha512sum ocaml-$VERSION.tar.{xz,gz} > new-sha512s
-cat new-sha512s >> SHA512SUM
-rm SHA512SUM.old new-sha512s
-
-# clean up
-rm /tmp/env-$USER.sh
-exit
-```
-
-
-## 9: update note files (technical documentation)
-
-```
-ssh $ARCHIVE_HOST "mkdir -p $DIST/notes"
-cd ocaml-$VERSION
-scp INSTALL.adoc LICENSE README.adoc README.win32.adoc Changes \
- $ARCHIVE_HOST:$DIST/notes/
-```
-
-
-## 10: upload the reference manual
-
-You don't need to do this if the previous release had the same
-$MAJOR.$MINOR ($BRANCH) value and the exact same manual -- this is frequent if
-it was a release candidate.
-
-```
-cd $WORKTREE
-make
-make install
-export PATH="$INSTDIR/bin:$PATH"
-cd manual
-make clean
-make
-rm -rf /tmp/release
-mkdir -p /tmp/release
-RELEASENAME="ocaml-$BRANCH-"
-make -C manual release RELEASE=/tmp/release/$RELEASENAME
-scp /tmp/release/* $ARCHIVE_HOST:$DIST/
-
-
-# upload manual checksums
-ssh $ARCHIVE_HOST "cd $DIST; md5sum ocaml-$BRANCH-refman* >>MD5SUM"
-ssh $ARCHIVE_HOST "cd $DIST; sha512sum ocaml-$BRANCH-refman* >>SHA512SUM"
-```
-
-Releasing the manual online happens on another machine:
-Do this ONLY FOR A PRODUCTION RELEASE
-
-```
-scp /tmp/env-$USER.sh $ARCHIVE_HOST:/tmp/env-$USER.sh
-ssh $ARCHIVE_HOST
-source /tmp/env-$USER.sh
-scp /tmp/env-$USER.sh $WEB_HOST:/tmp
-ssh $WEB_HOST
-source /tmp/env-$USER.sh
-
-cd $WEB_PATH/caml/pub/docs
-mkdir -p manual-ocaml-$BRANCH
-cd manual-ocaml-$BRANCH
-rm -fR htmlman ocaml-$BRANCH-refman-html.tar.gz
-wget http://caml.inria.fr/pub/distrib/ocaml-$BRANCH/ocaml-$BRANCH-refman-html.tar.gz
-tar -xzvf ocaml-$BRANCH-refman-html.tar.gz # this extracts into htmlman/
-/bin/cp -r htmlman/* . # move HTML content to docs/manual-caml-$BRANCH
-rm -fR htmlman ocaml-$BRANCH-refman-html.tar.gz
-
-cd $WEB_PATH/caml/pub/docs
-rm manual-ocaml
-ln -sf manual-ocaml-$BRANCH manual-ocaml
-```
-
-
-## 11: prepare web announce for the release
-
-For production releases, you should get in touch with ocaml.org to
-organize the webpage for the new release. See
-
- <https://github.com/ocaml/ocaml.org/issues/819>
-
-
-## 13: announce the release on caml-list and caml-announce
-
-See the email announce templates at the end of this file.
-
-
-
-# Appendix
-
-## Announcing a production release:
-
-```
-Dear OCaml users,
-
-We have the pleasure of celebrating <event> by announcing the release of
-OCaml version $VERSION.
-This is mainly a bug-fix release, see the list of changes below.
-
-It is (or soon will be) available as a set of OPAM switches,
-and as a source download here:
- https://caml.inria.fr/pub/distrib/ocaml-$BRANCH/
-
-Happy hacking,
-
--- Damien Doligez for the OCaml team.
-
-<< insert the relevant Changes section >>
-```
-
-## Announcing a release candidate:
-
-```
-Dear OCaml users,
-
-The release of OCaml version $MAJOR.$MINOR.$BUGFIX is imminent. We have
-created a release candidate that you can test.
-
-The source code is available at these addresses:
-
- https://github.com/ocaml/ocaml/archive/$VERSION.tar.gz
- https://caml.inria.fr/pub/distrib/ocaml-$BRANCH/ocaml-$VERSION.tar.gz
-
-The compiler can also be installed as an OPAM switch with one of the
-following commands.
-
-opam switch create ocaml-variants.$VERSION --repositories=default,beta=git+https://github.com/ocaml/ocaml-beta-repository.git
-
-or
-
-opam switch create ocaml-variants.$VERSION+<VARIANT> --repositories=default,beta=git+https://github.com/ocaml/ocaml-beta-repository.git
-
- where you replace <VARIANT> with one of these:
- afl
- default-unsafe-string
- force-safe-string
- flambda
- fp
- fp+flambda
-
-We want to know about all bugs. Please report them here:
- https://github.com/ocaml/ocaml/issues
-
-Happy hacking,
-
--- Damien Doligez for the OCaml team.
-
-<< insert the relevant Changes section >>
-```
-
-## Announcing a beta version:
-
-```
-Dear OCaml users,
-
-The release of OCaml $MAJOR.$MINOR.$BUGFIX is approaching. We have created
-a beta version to help you adapt your software to the new features
-ahead of the release.
-
-The source code is available at these addresses:
-
- https://github.com/ocaml/ocaml/archive/$VERSION.tar.gz
- https://caml.inria.fr/pub/distrib/ocaml-$BRANCH/$VERSION.tar.gz
-
-The compiler can also be installed as an OPAM switch with one of the
-following commands.
-
-opam switch create ocaml-variants.$VERSION --repositories=default,beta=git+https://github.com/ocaml/ocaml-beta-repository.git
-
-or
-
-opam switch create ocaml-variants.$VERSION+<VARIANT> --repositories=default,beta=git+https://github.com/ocaml/ocaml-beta-repository.git
-
- where you replace <VARIANT> with one of these:
- afl
- default-unsafe-string
- force-safe-string
- flambda
- fp
- fp+flambda
-
-We want to know about all bugs. Please report them here:
- https://github.com/ocaml/ocaml/issues
-
-Happy hacking,
-
--- Damien Doligez for the OCaml team.
-```
-
-## Changelog template for a new version
-
-A list of common subsection for the "Changes" file:
-
-```
-### Language features
-
-### Runtime system:
-
-### Code generation and optimizations:
-
-### Standard library:
-
-### Other libraries:
-
-### Tools:
-
-### Manual and documentation:
-
-### Compiler user-interface and warnings:
-
-### Internal/compiler-libs changes:
-
-### Build system:
-
-### Bug fixes:
-```
-
-
-## Changes curation
-
-Here is the process that Gabriel uses to curate the Changes entries of
-a release in preparation. Feel free to take care of it if you wish.
-
-(In theory it would be possible to maintain the Changes in excellent
- shape so that no curation would be necessary. In practice it is less
- work and less friction to tolerate imperfect Changes entries, and
- curate them before the release.)
-
-### Synchronizing the trunk Changes with release branches
-
-The Changes entries of a release branch or past release should be
-exactly included in the trunk Changes, in the section of this release
-(or release branch). Use an interactive diffing tool (for example
-"meld") to compare and synchronize the Changes files of trunk and
-release branches.
-
-Here are typical forms of divergence and their usual solutions:
-
-- A change entry is present in a different section in two branches.
- (Typically: in the XX.YY section of the XX.YY release branch,
- but in the trunk section of the trunk branch.)
-
- This usually happens when the PR is written for a given branch
- first, and then cherry-picked in an older maintenance branch, but
- the cherry-picker forgets to move the Change entry in the first
- branch.
-
- Fix: ensure that the entry is in the same section on all branches,
- by putting it in the "smallest" version -- assuming that all bigger
- versions also contain this cange.
-
-- A change entry is present in a given section, but the change is not
- present in the corresponding release branch.
-
- There are two common causes for this with radically different solutions:
-
- + If a PR is merged a long time after they were submitted, the merge
- may put their Changes entry in the section of an older release,
- while it should go in trunk.
-
- Fix: in trunk, move the entry to the trunk section.
-
- + Sometimes the author of a PR against trunk intends it to be
- cherry-picked in an older release branch, and places it in the
- corresponding Changes entry, but we forget to cherry-pick.
-
- Fix: cherry-pick the PR in the appropriate branch.
-
- Reading the PR discussion is often enough to distinguish between the
- two cases, but one should be careful before cherry-picking in
- a branch (for an active release branch, check with the release
- manager(s)).
-
-Figuring out the status of a given Changes entry often requires
-checking the git log for trunk and branches. Grepping for the PR
-number often suffices (note: when you cherry-pick a PR in a release
-branch, please target the merge commit to ensure the PR number is
-present in the log), or parts of the commit message text.
-
-### Ensure each entry is in the appropriate section
-
-(of course)
-
-### Fill more details in unclear Changes entries
-
-Expert users want to learn about the changes in the new release. We
-want to avoid forcing them to read the tortuous PR discussion, by
-giving enough details in the Changes entry.
-
-In particular, for language changes, showing a small example of
-concrete syntax of the new feature is very useful, and giving a few
-words of explanations helps.
-
-Compare for example
-
- - #8820: quoted string extensions
- (Gabriel Radanne, Leo White and Gabriel Scherer,
- request by Bikal Lem)
-
-with
-
- - #8820: quoted extensions: {%foo|...|} is lighter syntax for
- [%foo {||}], and {%foo bar|...|bar} for [%foo {bar|...|bar}].
- (Gabriel Radanne, Leo White and Gabriel Scherer,
- request by Bikal Lem)
-
-This is also important for changes that break compatibility; users
-will scrutinize them with more care, so please give clear information on
-what breaks and, possibly, recommended update methods.
-
-Having enough details is also useful when you will grep the Changes
-later to know when a given change was introduced (knowing what to grep
-can be difficult).
-
-### Ordering of Changes entries
-
-In the past, we would order Changes entries numerically (this would
-also correspond to a chronological order). Since 4.09 Gabriel is
-trying to order them by importance (being an exciting/notable feature
-for a large number of users). What is the best ordering of sections,
-and the best entry ordering within a section, to put the most
-important changes first? This is guesswork of course, and we commonly
-have a long tail of "not so important PRs" in each section which don't
-need to be ordered with respect to each other -- one may break two
-lines just before this long tail.
-
-The ordering of sections depends on the nature of the changes within
-the release; some releases have an exciting "Runtime" section, many
-release don't. Usually "Language features" is among the first, and
-"Bug fixes" is the very last (who cares about bugs, right?).
-
-If some entries feel very anecdotal, consider moving them to the Bug
-Fixes section.
--- /dev/null
+#!/usr/bin/env bash
+#**************************************************************************
+#* *
+#* OCaml *
+#* *
+#* John Whitington *
+#* *
+#* 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. *
+#* *
+#**************************************************************************
+
+#Allow to be run from outside tools/
+cd $(dirname "$0")/..
+
+if [[ ! -d stdlib || ! -d otherlibs ]] ; then
+ echo 'Cannot find the stdlib and otherlibs directories' >&2
+ exit 1
+fi
+
+#Removes a label, i.e a space, a variable name, followed by a colon followed by
+#an alphabetic character or ( or '. This should avoid altering the contents of
+#comments.
+LABREGEX="s/ [a-z_]+:([a-z\('])/ \1/g"
+
+#A second, slightly different round sometimes required to deal with f:(key:key
+LABLABREGEX="s/\([a-z_]+:([a-z\('])/\(\1/g"
+
+#Remove a tilde if it is followed by a label name and a space or closing
+#OCamldoc code section with ]
+TILDEREGEX="s/~([a-z_]+[ \]])/\1/g"
+
+#Indent a non-blank line by two characters, for moreLabels templates
+INDENTREGEX="s/^(.+)$/ \1/m"
+
+#Stdlib
+perl -p -e "$LABREGEX" stdlib/listLabels.mli > stdlib/list.temp.mli
+perl -p -e "$LABREGEX" stdlib/arrayLabels.mli > stdlib/array.temp.mli
+perl -p -e "$LABREGEX" stdlib/stringLabels.mli > stdlib/string.temp.mli
+perl -p -e "$LABREGEX" stdlib/bytesLabels.mli > stdlib/bytes.temp.mli
+
+#Stdlib tildes
+perl -p -e "$TILDEREGEX" stdlib/list.temp.mli > stdlib/list.mli
+perl -p -e "$TILDEREGEX" stdlib/array.temp.mli > stdlib/array.mli
+perl -p -e "$TILDEREGEX" stdlib/string.temp.mli > stdlib/string.mli
+perl -p -e "$TILDEREGEX" stdlib/bytes.temp.mli > stdlib/bytes.mli
+
+#FloatArrayLabels
+perl -p -e "$LABREGEX" \
+ stdlib/templates/floatarraylabeled.template.mli > \
+ stdlib/templates/floatarrayunlabeled.temp.mli
+perl -p -e "$TILDEREGEX" stdlib/templates/floatarrayunlabeled.temp.mli > \
+ stdlib/templates/floatarrayunlabeled.2temp.mli
+perl -p -e "$INDENTREGEX" stdlib/templates/floatarraylabeled.template.mli > \
+ stdlib/templates/fal.indented.temp.mli
+perl -p -e "$INDENTREGEX" stdlib/templates/floatarrayunlabeled.2temp.mli > \
+ stdlib/templates/fau.indented.temp.mli
+perl -p -e\
+ 's/FLOATARRAYLAB/`tail -n +17 stdlib\/templates\/fal.indented.temp.mli`/e' \
+ stdlib/templates/float.template.mli > \
+ stdlib/templates/float.template.temp.mli
+perl -p -e\
+ 's/FLOATARRAY/`tail -n +17 stdlib\/templates\/fau.indented.temp.mli`/e' \
+ stdlib/templates/float.template.temp.mli > \
+ stdlib/float.mli
+
+#MoreLabels
+perl -p -e "$LABREGEX" \
+ stdlib/templates/hashtbl.template.mli > stdlib/hashtbl.temp.mli
+perl -p -e "$LABLABREGEX" \
+ stdlib/hashtbl.temp.mli > stdlib/hashtbl.2temp.mli
+perl -p -e "$LABREGEX" \
+ stdlib/templates/map.template.mli > stdlib/map.temp.mli
+perl -p -e "$LABLABREGEX" \
+ stdlib/map.temp.mli > stdlib/map.2temp.mli
+perl -p -e "$LABREGEX" \
+ stdlib/templates/set.template.mli > stdlib/set.temp.mli
+perl -p -e "$LABLABREGEX" \
+ stdlib/set.temp.mli > stdlib/set.2temp.mli
+
+#MoreLabels tildes
+perl -p -e "$TILDEREGEX" stdlib/hashtbl.2temp.mli > stdlib/hashtbl.mli
+perl -p -e "$TILDEREGEX" stdlib/map.2temp.mli > stdlib/map.mli
+perl -p -e "$TILDEREGEX" stdlib/set.2temp.mli > stdlib/set.mli
+
+#Indent the labeled modules
+perl -p -e "$INDENTREGEX" stdlib/templates/hashtbl.template.mli > \
+ stdlib/templates/hashtbl.template.temp.mli
+perl -p -e "$INDENTREGEX" stdlib/templates/map.template.mli > \
+ stdlib/templates/map.template.temp.mli
+perl -p -e "$INDENTREGEX" stdlib/templates/set.template.mli > \
+ stdlib/templates/set.template.temp.mli
+
+#Substitute the labeled modules in to moreLabels.mli
+perl -p -e\
+ 's/HASHTBL/`tail -n +19 stdlib\/templates\/hashtbl.template.temp.mli`/e' \
+ stdlib/templates/moreLabels.template.mli > stdlib/moreLabels.temp.mli
+perl -p -e 's/MAP/`tail -n +19 stdlib\/templates\/map.template.temp.mli`/e' \
+ stdlib/moreLabels.temp.mli > stdlib/moreLabels.2temp.mli
+perl -p -e 's/SET/`tail -n +19 stdlib\/templates\/set.template.temp.mli`/e' \
+ stdlib/moreLabels.2temp.mli > stdlib/moreLabels.mli
+
+#Fix up with templates in tools/unlabel-patches
+perl -p -e "s/type statistics =/type statistics = Hashtbl\.statistics =/" \
+ stdlib/moreLabels.mli > stdlib/moreLabels.temp.mli
+perl -p -e "s/type \(!'a, !'b\) t/type \(!'a, !'b\) t = \('a, 'b) Hashtbl.t/" \
+ stdlib/moreLabels.temp.mli > stdlib/moreLabels.2temp.mli
+perl -p -e\
+ "s/module Make \(H : HashedType\) : S with type key = H.t\
+/`cat tools/unlabel-patches/1.mli`/" \
+ stdlib/moreLabels.2temp.mli > stdlib/moreLabels.3temp.mli
+perl -p -e\
+ "s/module MakeSeeded \(H : SeededHashedType\) : SeededS with type key = H.t\
+/`cat tools/unlabel-patches/2.mli`/" \
+ stdlib/moreLabels.3temp.mli > stdlib/moreLabels.4temp.mli
+perl -p -e\
+ "s/module Make \(Ord : OrderedType\) : S with type key = Ord.t\
+/`cat tools/unlabel-patches/3.mli`/" \
+ stdlib/moreLabels.4temp.mli > stdlib/moreLabels.5temp.mli
+perl -p -e\
+ "s/module Make \(Ord : OrderedType\) : S with type elt = Ord.t\
+/`cat tools/unlabel-patches/4.mli`/" \
+ stdlib/moreLabels.5temp.mli > stdlib/moreLabels.mli
+
+#Unix
+perl -p -e "$LABREGEX" \
+ otherlibs/unix/unixLabels.mli > otherlibs/unix/unix.temp.mli
+#Tildes
+perl -p -e "$TILDEREGEX" \
+ otherlibs/unix/unix.temp.mli > otherlibs/unix/unix.2temp.mli
+
+#Remove type equivalences from unix.mli
+perl -p -e 's/ = Unix.[a-z_]+//' \
+ otherlibs/unix/unix.2temp.mli > otherlibs/unix/unix.3temp.mli
+perl -p -e 's/ = Unix.LargeFile.stats//' \
+ otherlibs/unix/unix.3temp.mli > otherlibs/unix/unix.mli
+
+#Clean up
+rm -f stdlib/*temp.mli
+rm -f otherlibs/unix/*temp.mli
+rm -f stdlib/templates/*temp.mli
--- /dev/null
+ module Make : functor (H : HashedType) -> S
+ with type key = H.t
+ and type 'a t = 'a Hashtbl.Make(H).t
--- /dev/null
+ module MakeSeeded (H : SeededHashedType) : SeededS
+ with type key = H.t
+ and type 'a t = 'a Hashtbl.MakeSeeded(H).t
--- /dev/null
+ module Make : functor (Ord : OrderedType) -> S
+ with type key = Ord.t
+ and type 'a t = 'a Map.Make(Ord).t
--- /dev/null
+ module Make : functor (Ord : OrderedType) -> S
+ with type elt = Ord.t
+ and type t = Set.Make(Ord).t
(targets ocaml.byte)
(action (run %{ocaml_where}/expunge %{dep:topstart.exe} %{targets}
; FIXME: inlined $(STDLIB_MODULES) ... minus Labels ones ...
- stdlib__Spacetime
stdlib__Arg
stdlib__Array
; stdlib__ArrayLabels
stdlib__Char
stdlib__Complex
stdlib__Digest
+ stdlib__Either
stdlib__Ephemeron
stdlib__Filename
stdlib__Float
a case (PR#6669).
Unfortunately, there is a corner-case that *is*
- a real cycle: using -rectypes one can define
- let rec x = lazy x
+ a real cycle: using unboxed types one can define
+
+ type t = T : t Lazy.t -> t [@@unboxed]
+ let rec x = lazy (T x)
+
which creates a Forward_tagged block that points to
itself. For this reason, we still "nest"
(detect head cycles) on forward tags.
Oval_stuff "<abstr>"
| {type_kind = Type_abstract; type_manifest = Some body} ->
tree_of_val depth obj
- (try Ctype.apply env decl.type_params body ty_list with
- Ctype.Cannot_apply -> abstract_type)
+ (instantiate_type env decl.type_params ty_list body)
| {type_kind = Type_variant constr_list; type_unboxed} ->
let unbx = type_unboxed.unboxed in
let tag =
match cd_args with
| Cstr_tuple l ->
let ty_args =
- List.map
- (function ty ->
- try Ctype.apply env type_params ty ty_list with
- Ctype.Cannot_apply -> abstract_type)
- l
- in
+ instantiate_types env type_params ty_list l in
tree_of_constr_with_args (tree_of_constr env path)
(Ident.name cd_id) false 0 depth obj
ty_args unbx
lbl_list pos obj unbx
end
| {type_kind = Type_open} ->
- tree_of_extension path depth obj
+ tree_of_extension path ty_list depth obj
with
Not_found -> (* raised by Env.find_type *)
Oval_stuff "<abstr>"
let rec tree_of_fields pos = function
| [] -> []
| {ld_id; ld_type} :: remainder ->
- let ty_arg =
- try
- Ctype.apply env type_params ld_type
- ty_list
- with
- Ctype.Cannot_apply -> abstract_type in
+ let ty_arg = instantiate_type env type_params ty_list ld_type in
let name = Ident.name ld_id in
(* PR#5722: print full module path only
for first record field *)
in
Oval_constr (lid, args)
- and tree_of_extension type_path depth bucket =
+ and tree_of_extension type_path ty_list depth bucket =
let slot =
if O.tag bucket <> 0 then bucket
else O.field bucket 0
identifier contained in the exception bucket *)
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
+ Tconstr (_,params,_) ->
+ params
+ | _ -> assert false
+ in
+ let args = instantiate_types env type_params ty_list cstr.cstr_args in
tree_of_constr_with_args
(fun x -> Oide_ident x) name (cstr.cstr_inlined <> None)
1 depth bucket
- cstr.cstr_args false
+ args false
with Not_found | EVP.Error ->
match check_depth depth bucket ty with
Some x -> x
| None ->
Oval_stuff "<extension>"
+ and instantiate_type env type_params ty_list ty =
+ try Ctype.apply env type_params ty ty_list
+ with Ctype.Cannot_apply -> abstract_type
+
+ and instantiate_types env type_params ty_list args =
+ List.map (instantiate_type env type_params ty_list) args
+
and find_printer depth env ty =
let rec find = function
| [] -> raise Not_found
Oval_printer printer)
- in nest tree_of_val max_depth obj ty
+ in nest tree_of_val max_depth obj (Ctype.correct_levels ty)
end
(* To quit *)
-let dir_quit () = exit 0
+let dir_quit () = raise (Compenv.Exit_with_status 0)
let _ = Hashtbl.add directive_table "quit" (Directive_none dir_quit)
if !Clflags.dump_source then Pprintast.top_phrase ppf phr;
ignore(execute_phrase true ppf phr)
with
- | End_of_file -> exit 0
+ | End_of_file -> raise (Compenv.Exit_with_status 0)
| Sys.Break -> fprintf ppf "Interrupted.@."; Btype.backtrack snap
| PPerror -> ()
| x -> Location.report_exception ppf x; Btype.backtrack snap
(* *)
(**************************************************************************)
-open Clflags
+open Compenv
let usage =
"Usage: ocamlnat <options> <object-files> [script-file]\noptions are:"
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;
- exit 2
+ raise (Exit_with_status 2)
end else begin
let newargs = Array.sub !argv !Arg.current
(Array.length !argv - !Arg.current)
in
Compmisc.read_clflags_from_env ();
if prepare ppf && Opttoploop.run_script ppf name newargs
- then exit 0
- else exit 2
+ then raise (Exit_with_status 0)
+ else raise (Exit_with_status 2)
end
let wrap_expand f s =
Clflags.include_dirs := List.rev_append extra_paths !Clflags.include_dirs
let main () =
- native_code := true;
+ Clflags.native_code := true;
let list = ref Options.list in
begin
try
Arg.parse_and_expand_argv_dynamic current argv list file_argument usage;
with
- | Arg.Bad msg -> Format.fprintf Format.err_formatter "%s%!" msg; exit 2
- | Arg.Help msg -> Format.fprintf Format.std_formatter "%s%!" msg; exit 0
+ | Arg.Bad msg -> Format.fprintf Format.err_formatter "%s%!" msg;
+ raise (Exit_with_status 2)
+ | Arg.Help msg -> Format.fprintf Format.std_formatter "%s%!" msg;
+ raise (Exit_with_status 0)
end;
Compmisc.read_clflags_from_env ();
- if not (prepare Format.err_formatter) then exit 2;
+ if not (prepare Format.err_formatter) then raise (Exit_with_status 2);
Compmisc.init_path ();
Opttoploop.loop Format.std_formatter
+
+let main () =
+ match main () with
+ | exception Exit_with_status n -> n
+ | () -> 0
(* Start the [ocaml] toplevel loop *)
-val main: unit -> unit
+val main: unit -> int
(* *)
(**************************************************************************)
-let _ = Opttopmain.main()
+let _ = exit (Opttopmain.main())
(* To quit *)
-let dir_quit () = exit 0
+let dir_quit () = raise (Compenv.Exit_with_status 0)
let _ = add_directive "quit" (Directive_none dir_quit)
{
Symtable.update_global_table();
let initial_bindings = !toplevel_value_bindings in
let bytecode, closure = Meta.reify_bytecode code [| events |] None in
- try
+ match
may_trace := true;
- let retval = closure () in
- may_trace := false;
- if can_free then Meta.release_bytecode bytecode;
- Result retval
- with x ->
- may_trace := false;
- if can_free then Meta.release_bytecode bytecode;
+ Fun.protect
+ ~finally:(fun () -> may_trace := false;
+ if can_free then Meta.release_bytecode bytecode)
+ closure
+ with
+ | retval -> Result retval
+ | exception x ->
record_backtrace ();
toplevel_value_bindings := initial_bindings; (* PR#6211 *)
Symtable.restore_state initial_symtable;
begin
try initialize_toplevel_env ()
with Env.Error _ | Typetexp.Error _ as exn ->
- Location.report_exception ppf exn; exit 2
+ Location.report_exception ppf exn; raise (Compenv.Exit_with_status 2)
end;
let lb = Lexing.from_function refill_lexbuf in
Location.init lb "//toplevel//";
Env.reset_cache_toplevel ();
ignore(execute_phrase true ppf phr)
with
- | End_of_file -> exit 0
+ | End_of_file -> raise (Compenv.Exit_with_status 0)
| Sys.Break -> fprintf ppf "Interrupted.@."; Btype.backtrack snap
| PPerror -> ()
| x -> Location.report_exception ppf x; Btype.backtrack snap
begin
try toplevel_env := Compmisc.initial_env()
with Env.Error _ | Typetexp.Error _ as exn ->
- Location.report_exception ppf exn; exit 2
+ Location.report_exception ppf exn; raise (Compenv.Exit_with_status 2)
end;
Sys.interactive := false;
run_hooks After_setup;
(* *)
(**************************************************************************)
-open Compenv
-
let usage = "Usage: ocaml <options> <object-files> [script-file [arguments]]\n\
options are:"
try
let res =
let objects =
- List.rev (!preload_objects @ !first_objfiles)
+ List.rev (!preload_objects @ !Compenv.first_objfiles)
in
List.for_all (Topdirs.load_file ppf) objects
in
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;
- exit 2
+ raise (Compenv.Exit_with_status 2)
end else begin
let newargs = Array.sub !argv !current
(Array.length !argv - !current)
Compenv.readenv ppf Before_link;
Compmisc.read_clflags_from_env ();
if prepare ppf && Toploop.run_script ppf name newargs
- then exit 0
- else exit 2
+ then raise (Compenv.Exit_with_status 0)
+ else raise (Compenv.Exit_with_status 2)
end
try
Arg.parse_and_expand_argv_dynamic current argv list file_argument usage;
with
- | Arg.Bad msg -> Printf.eprintf "%s" msg; exit 2
- | Arg.Help msg -> Printf.printf "%s" msg; exit 0
+ | Arg.Bad msg -> Printf.eprintf "%s" msg; raise (Compenv.Exit_with_status 2)
+ | Arg.Help msg -> Printf.printf "%s" msg; raise (Compenv.Exit_with_status 0)
end;
Compenv.readenv ppf Before_link;
Compmisc.read_clflags_from_env ();
- if not (prepare ppf) then exit 2;
+ if not (prepare ppf) then raise (Compenv.Exit_with_status 2);
Compmisc.init_path ();
Toploop.loop Format.std_formatter
+
+let main () =
+ match main () with
+ | exception Compenv.Exit_with_status n -> n
+ | () -> 0
(* *)
(**************************************************************************)
-(* Start the [ocaml] toplevel loop *)
+(* Start the [ocaml] toplevel loop, and return the exit code *)
-val main: unit -> unit
+val main: unit -> int
(* *)
(**************************************************************************)
-let _ = Topmain.main()
+let _ = exit (Topmain.main())
open Types
open Toploop
-type codeptr = Obj.t
+type codeptr = Obj.raw_data
type traced_function =
{ path: Path.t; (* Name under which it is traced *)
(* Get or overwrite the code pointer of a closure *)
-let get_code_pointer cls = Obj.field cls 0
+let get_code_pointer cls =
+ assert (let t = Obj.tag cls in t = Obj.closure_tag || t = Obj.infix_tag);
+ Obj.raw_field cls 0
-let set_code_pointer cls ptr = Obj.set_field cls 0 ptr
+let set_code_pointer cls ptr =
+ assert (let t = Obj.tag cls in t = Obj.closure_tag || t = Obj.infix_tag);
+ Obj.set_raw_field cls 0 ptr
(* Call a traced function (use old code pointer, but new closure as
environment so that recursive calls are also traced).
open Asttypes
open Types
+open Local_store
+
(**** Sets, maps and hashtables of types ****)
module TypeSet = Set.Make(TypeOps)
(**** Some type creators ****)
-let new_id = ref (-1)
+let new_id = s_ref (-1)
let newty2 level desc =
incr new_id; { desc; level; scope = lowest_level; id = !new_id }
| Unchanged
| Invalid
-let trail = Weak.create 1
+let trail = s_table Weak.create 1
let log_change ch =
- match Weak.get trail 0 with None -> ()
+ match Weak.get !trail 0 with None -> ()
| Some r ->
let r' = ref Unchanged in
r := Change (ch, r');
- Weak.set trail 0 (Some r')
+ Weak.set !trail 0 (Some r')
(**** Representative of a type ****)
| _ -> ()
*)
-let memo = ref []
+let memo = s_ref []
(* Contains the list of saved abbreviation expansions. *)
let cleanup_abbrev () =
| Ctypeset (r, v) -> r := v
type snapshot = changes ref * int
-let last_snapshot = ref 0
+let last_snapshot = s_ref 0
let log_type ty =
if ty.id <= !last_snapshot then log_change (Ctype (ty, ty.desc))
let snapshot () =
let old = !last_snapshot in
last_snapshot := !new_id;
- match Weak.get trail 0 with Some r -> (r, old)
+ match Weak.get !trail 0 with Some r -> (r, old)
| None ->
let r = ref Unchanged in
- Weak.set trail 0 (Some r);
+ Weak.set !trail 0 (Some r);
(r, old)
let rec rev_log accu = function
List.iter undo_change backlog;
changes := Unchanged;
last_snapshot := old;
- Weak.set trail 0 (Some changes)
+ Weak.set !trail 0 (Some changes)
let rec rev_compress_log log r =
match !r with
open Types
open Btype
+open Local_store
+
(*
Type manipulation after type inference
======================================
(**** Type level management ****)
-let current_level = ref 0
-let nongen_level = ref 0
-let global_level = ref 1
-let saved_level = ref []
+let current_level = s_ref 0
+let nongen_level = s_ref 0
+let global_level = s_ref 1
+let saved_level = s_ref []
type levels =
{ current_level: int; nongen_level: int; global_level: int;
| Expression (* unification in expression *)
| Pattern (* unification in pattern which may add local constraints *)
+type equations_generation =
+ | Forbidden
+ | Allowed of { equated_types : unit TypePairs.t }
+
let umode = ref Expression
-let generate_equations = ref false
+let equations_generation = ref Forbidden
let assume_injective = ref false
+let allow_recursive_equation = ref false
+
+let can_generate_equations () =
+ match !equations_generation with
+ | Forbidden -> false
+ | _ -> true
-let set_mode_pattern ~generate ~injective f =
+let set_mode_pattern ~generate ~injective ~allow_recursive f =
Misc.protect_refs
- [Misc.R (umode, Pattern);
- Misc.R (generate_equations, generate);
- Misc.R (assume_injective, injective)] f
+ [ Misc.R (umode, Pattern);
+ Misc.R (equations_generation, generate);
+ Misc.R (assume_injective, injective);
+ Misc.R (allow_recursive_equation, allow_recursive);
+ ] f
(*** Checks for type definitions ***)
normalize_package_path env (Path.Pdot (p1', s))
| _ -> p
-let check_scope_escape env level ty =
- let rec loop ty =
- let ty = repr ty in
- if ty.level >= lowest_level then begin
- ty.level <- pivot_level - ty.level;
- if level < ty.scope then
- raise(Trace.scope_escape ty);
- begin match ty.desc with
- | Tconstr (p, _, _) when level < Path.scope p ->
- begin match !forward_try_expand_once env ty with
- | ty' -> aux ty'
- | exception Cannot_expand ->
- raise Trace.(Unify [escape (Constructor p)])
- end
- | Tpackage (p, nl, tl) when level < Path.scope p ->
- let p' = normalize_package_path env p in
- if Path.same p p' then raise Trace.(Unify [escape (Module_type p)]);
- aux { ty with desc = Tpackage (p', nl, tl) }
- | _ ->
- iter_type_expr loop ty
- end;
- end
- and aux ty =
- loop ty;
- unmark_type ty
+let rec check_scope_escape env level ty =
+ let mark ty =
+ (* Mark visited types with [ty.level < lowest_level]. *)
+ set_level ty (pivot_level - ty.level)
in
- try aux ty;
+ let ty = repr ty in
+ (* If the type hasn't been marked, check it. Otherwise, we have already
+ checked it.
+ *)
+ if ty.level >= lowest_level then begin
+ if level < ty.scope then
+ raise(Trace.scope_escape ty);
+ begin match ty.desc with
+ | Tconstr (p, _, _) when level < Path.scope p ->
+ begin match !forward_try_expand_once env ty with
+ | ty' ->
+ mark ty;
+ check_scope_escape env level ty'
+ | exception Cannot_expand ->
+ raise Trace.(Unify [escape (Constructor p)])
+ end
+ | Tpackage (p, nl, tl) when level < Path.scope p ->
+ let p' = normalize_package_path env p in
+ if Path.same p p' then raise Trace.(Unify [escape (Module_type p)]);
+ let orig_level = ty.level in
+ mark ty;
+ check_scope_escape env level
+ (Btype.newty2 orig_level (Tpackage (p', nl, tl)))
+ | _ ->
+ mark ty;
+ iter_type_expr (check_scope_escape env level) ty
+ end;
+ end
+
+let check_scope_escape env level ty =
+ let snap = snapshot () in
+ try check_scope_escape env level ty; backtrack snap
with Unify [Trace.Escape x] ->
+ backtrack snap;
raise Trace.(Unify[Escape { x with context = Some ty }])
let update_scope scope ty =
| Tconstr(p, (_ :: _ as tl), _) ->
let variance =
try (Env.find_type p env).type_variance
- with Not_found -> List.map (fun _ -> Variance.may_inv) tl in
+ with Not_found -> List.map (fun _ -> Variance.unknown) tl in
let needs_expand =
expand ||
List.exists2
typ.type_kind = Type_abstract
with Not_found ->
(* See testsuite/tests/typing-missing-cmi-2 for an example *)
- List.map (fun _ -> Variance.may_inv) tyl,
+ List.map (fun _ -> Variance.unknown) tyl,
false
in
if List.for_all ((=) Variance.null) variance then () else
try !(TypeHash.find node_univars ty) with Not_found -> TypeSet.empty
+let fully_generic ty =
+ let rec aux acc ty =
+ acc &&
+ let ty = repr ty in
+ ty.level < lowest_level || (
+ ty.level = generic_level && (
+ mark_type_node ty;
+ fold_type_expr aux true ty
+ )
+ )
+ in
+ let res = aux true ty in
+ unmark_type ty;
+ res
+
+
(*******************)
(* Instantiation *)
(*******************)
let merge r b = if b then r := true
let occur env ty0 ty =
- let allow_recursive = !Clflags.recursive_types || !umode = Pattern in
+ let allow_recursive =
+ !Clflags.recursive_types || !umode = Pattern && !allow_recursive_equation in
let old = !type_changed in
try
while
(* PR#6992: we actually need it for contractiveness *)
(* This is a simplified version of occur, only for the rectypes case *)
-let rec local_non_recursive_abbrev strict visited env p ty =
+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
Tconstr(p', args, _abbrev) ->
if Path.same p p' then raise Occur;
- if not strict && is_contractive env p' then () else
+ if allow_rec && not strict && is_contractive env p' then () else
let visited = ty :: visited in
begin try
(* try expanding, since [p] could be hidden *)
- local_non_recursive_abbrev strict visited env p
+ local_non_recursive_abbrev ~allow_rec strict visited env p
(try_expand_head try_expand_once_opt env ty)
with Cannot_expand ->
let params =
List.iter2
(fun tv ty ->
let strict = strict || not (is_Tvar (repr tv)) in
- local_non_recursive_abbrev strict visited env p ty)
+ local_non_recursive_abbrev ~allow_rec strict visited env p ty)
params args
end
+ | Tobject _ | Tvariant _ when not strict ->
+ ()
| _ ->
- if strict then (* PR#7374 *)
+ if strict || not allow_rec then (* PR#7374 *)
let visited = ty :: visited in
- iter_type_expr (local_non_recursive_abbrev true visited env p) ty
+ iter_type_expr
+ (local_non_recursive_abbrev ~allow_rec true visited env p) ty
end
let local_non_recursive_abbrev env p ty =
+ let allow_rec =
+ !Clflags.recursive_types || !umode = Pattern && !allow_recursive_equation in
try (* PR#7397: need to check trace_gadt_instances *)
wrap_trace_gadt_instances env
- (local_non_recursive_abbrev false [] env p) ty;
+ (local_non_recursive_abbrev ~allow_rec false [] env p) ty;
true
with Occur -> false
let deep_occur t0 ty =
let rec occur_rec ty =
let ty = repr ty in
- if ty.level >= lowest_level then begin
+ if ty.level >= t0.level then begin
if ty == t0 then raise Occur;
ty.level <- pivot_level - ty.level;
iter_type_expr occur_rec ty
let nondep_type' = ref (fun _ _ _ -> assert false)
let package_subtype = ref (fun _ _ _ _ _ _ _ -> assert false)
+exception Nondep_cannot_erase of Ident.t
+
let rec concat_longident lid1 =
let open Longident in
function
match Env.find_type_by_name lid env' with
| (_, {type_arity = 0; type_kind = Type_abstract;
type_private = Public; type_manifest = Some t2}) ->
- (n, nondep_instance env' lv2 id2 t2) :: complete nl ntl2
+ begin match nondep_instance env' lv2 id2 t2 with
+ | t -> (n, t) :: complete nl ntl2
+ | exception Nondep_cannot_erase _ ->
+ if allow_absent then
+ complete nl ntl2
+ else
+ raise Exit
+ end
| (_, {type_arity = 0; type_kind = Type_abstract;
type_private = Public; type_manifest = None})
when allow_absent ->
t1.desc <- d1;
raise e
+(* 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) ()
+
let rec unify (env:Env.t ref) t1 t2 =
(* First step: special cases (optimizations) *)
if t1 == t2 then () else
| (Ttuple tl1, Ttuple tl2) ->
unify_list env tl1 tl2
| (Tconstr (p1, tl1, _), Tconstr (p2, tl2, _)) when Path.same p1 p2 ->
- if !umode = Expression || not !generate_equations then
+ if !umode = Expression || !equations_generation = Forbidden then
unify_list env tl1 tl2
else if !assume_injective then
- set_mode_pattern ~generate:true ~injective:false
- (fun () -> unify_list env tl1 tl2)
+ set_mode_pattern ~generate:!equations_generation ~injective:false
+ ~allow_recursive:!allow_recursive_equation
+ (fun () -> unify_list env tl1 tl2)
else if in_current_module p1 (* || in_pervasives p1 *)
|| List.exists (expands_to_datatype !env) [t1'; t1; t2] then
unify_list env tl1 tl2
List.iter2
(fun i (t1, t2) ->
if i then unify env t1 t2 else
- set_mode_pattern ~generate:false ~injective:false
+ set_mode_pattern ~generate:Forbidden ~injective:false
+ ~allow_recursive:!allow_recursive_equation
begin fun () ->
let snap = snapshot () in
try unify env t1 t2 with Unify _ ->
| (Tconstr (path,[],_),
Tconstr (path',[],_))
when is_instantiable !env path && is_instantiable !env path'
- && !generate_equations ->
+ && can_generate_equations () ->
let source, destination =
if Path.scope path > Path.scope path'
then path , t2'
else path', t1'
in
+ record_equation t1' t2';
add_gadt_equation env source destination
| (Tconstr (path,[],_), _)
- when is_instantiable !env path && !generate_equations ->
+ when is_instantiable !env path && can_generate_equations () ->
reify env t2';
+ record_equation t1' t2';
add_gadt_equation env path t2'
| (_, Tconstr (path,[],_))
- when is_instantiable !env path && !generate_equations ->
+ when is_instantiable !env path && can_generate_equations () ->
reify env t1';
+ record_equation t1' t2';
add_gadt_equation env path t1'
| (Tconstr (_,_,_), _) | (_, Tconstr (_,_,_)) when !umode = Pattern ->
reify env t1';
reify env t2';
- if !generate_equations then mcomp !env t1' t2'
+ if can_generate_equations () then (
+ mcomp !env t1' t2';
+ record_equation t1' t2'
+ )
| (Tobject (fi1, nm1), Tobject (fi2, _)) ->
unify_fields env fi1 fi2;
(* Type [t2'] may have been instantiated by [unify_fields] *)
backtrack snap;
reify env t1';
reify env t2';
- if !generate_equations then mcomp !env t1' t2'
+ if can_generate_equations () then (
+ mcomp !env t1' t2';
+ record_equation t1' t2'
+ )
end
| (Tfield(f,kind,_,rem), Tnil) | (Tnil, Tfield(f,kind,_,rem)) ->
begin match field_kind_repr kind with
undo_compress snap;
raise (Unify (expand_trace !env trace))
-let unify_gadt ~equations_level:lev (env:Env.t ref) ty1 ty2 =
+let unify_gadt ~equations_level:lev ~allow_recursive (env:Env.t ref) ty1 ty2 =
try
univar_pairs := [];
gadt_equations_level := Some lev;
- set_mode_pattern ~generate:true ~injective:true
- (fun () -> unify env ty1 ty2);
+ let equated_types = TypePairs.create 0 in
+ set_mode_pattern
+ ~generate:(Allowed { equated_types })
+ ~injective:true
+ ~allow_recursive
+ (fun () -> unify env ty1 ty2);
gadt_equations_level := None;
TypePairs.clear unify_eq_set;
+ equated_types
with e ->
gadt_equations_level := None;
TypePairs.clear unify_eq_set;
(* Normalize a type before printing, saving... *)
(* Cannot use mark_type because deep_occur uses it too *)
-let rec normalize_type_rec env visited ty =
+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 tyl' =
List.fold_left
(fun tyl ty ->
- if List.exists (fun ty' -> equal env false [ty] [ty']) tyl
+ if List.exists
+ (fun ty' -> equal Env.empty false [ty] [ty']) tyl
then tyl else ty::tyl)
[ty] tyl
in
set_type_desc fi fi'.desc
| _ -> ()
end;
- iter_type_expr (normalize_type_rec env visited) ty
+ iter_type_expr (normalize_type_rec visited) ty
end
-let normalize_type env ty =
- normalize_type_rec env (ref TypeSet.empty) ty
+let normalize_type ty =
+ normalize_type_rec (ref TypeSet.empty) ty
(*************************)
let clear_hash () =
TypeHash.clear nondep_hash; TypeHash.clear nondep_variants
-exception Nondep_cannot_erase of Ident.t
-
let rec nondep_type_rec ?(expand_private=false) env ids ty =
let expand_abbrev env t =
if expand_private then expand_abbrev_opt env t else expand_abbrev env t
open Asttypes
open Types
+module TypePairs : Hashtbl.S with type key = type_expr * type_expr
+
module Unification_trace: sig
(** Unification traces are used to explain unification errors
when printing error messages *)
val object_fields: type_expr -> type_expr
val flatten_fields:
type_expr -> (string * field_kind * type_expr) list * type_expr
- (* Transform a field type into a list of pairs label-type *)
- (* The fields are sorted *)
+(** Transform a field type into a list of pairs label-type.
+ The fields are sorted.
+
+ Beware of the interaction with GADTs:
+
+ Due to the introduction of object indexes for GADTs, the row variable of
+ an object may now be an expansible type abbreviation.
+ A first consequence is that [flatten_fields] will not completely flatten
+ the object, since the type abbreviation will not be expanded
+ ([flatten_fields] does not receive the current environment).
+ Another consequence is that various functions may be called with the
+ expansion of this type abbreviation, which is a Tfield, e.g. during
+ printing.
+
+ Concrete problems have been fixed, but new bugs may appear in the
+ future. (Test cases were added to typing-gadts/test.ml)
+*)
+
val associate_fields:
(string * field_kind * type_expr) list ->
(string * field_kind * type_expr) list ->
(* Only generalize some part of the type
Make the remaining of the type non-generalizable *)
+val fully_generic: type_expr -> bool
+
val check_scope_escape : Env.t -> int -> type_expr -> unit
(* [check_scope_escape env lvl ty] ensures that [ty] could be raised
to the level [lvl] without any scope escape.
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 -> Env.t ref -> type_expr -> type_expr -> unit
+ equations_level:int -> allow_recursive:bool ->
+ Env.t ref -> type_expr -> type_expr -> unit TypePairs.t
(* Unify the two types given and update the environment with the
- local constraints. Raise [Unify] if not possible. *)
+ local constraints. Raise [Unify] if not possible.
+ Returns the pairs of types that have been equated. *)
val unify_var: Env.t -> type_expr -> type_expr -> unit
(* Same as [unify], but allow free univars when first type
is a variable. *)
(*val correct_abbrev: Env.t -> Path.t -> type_expr list -> type_expr -> unit*)
val cyclic_abbrev: Env.t -> Ident.t -> type_expr -> bool
val is_contractive: Env.t -> Path.t -> bool
-val normalize_type: Env.t -> type_expr -> unit
+val normalize_type: type_expr -> unit
val closed_schema: Env.t -> type_expr -> bool
(* Check whether the given type scheme contains no non-generic
type_kind = Type_record (lbls, rep);
type_private = priv;
type_manifest = None;
- type_variance = List.map (fun _ -> Variance.full) type_params;
+ type_variance = Variance.unknown_signature ~injective:true ~arity;
type_separability = Types.Separability.default_signature ~arity;
type_is_newtype = false;
type_expansion_scope = Btype.lowest_level;
open Types
open Btype
+open Local_store
+
module String = Misc.Stdlib.String
let add_delayed_check_forward = ref (fun _ -> assert false)
(inclusion test between signatures, cf Includemod.value_descriptions, ...).
*)
-let value_declarations : unit usage_tbl = Types.Uid.Tbl.create 16
-let type_declarations : unit usage_tbl = Types.Uid.Tbl.create 16
-let module_declarations : unit usage_tbl = Types.Uid.Tbl.create 16
+let value_declarations : unit usage_tbl ref = s_table Types.Uid.Tbl.create 16
+let type_declarations : unit usage_tbl ref = s_table Types.Uid.Tbl.create 16
+let module_declarations : unit usage_tbl ref = s_table Types.Uid.Tbl.create 16
type constructor_usage = Positive | Pattern | Privatize
type constructor_usages =
let constructor_usages () =
{cu_positive = false; cu_pattern = false; cu_privatize = false}
-let used_constructors : constructor_usage usage_tbl = Types.Uid.Tbl.create 16
+let used_constructors : constructor_usage usage_tbl ref =
+ s_table Types.Uid.Tbl.create 16
(** Map indexed by the name of module components. *)
module NameMap = String.Map
val get : unit -> modname
val set : modname -> unit
val is : modname -> bool
- val is_name_of : Ident.t -> bool
+ val is_ident : Ident.t -> bool
+ val is_path : Path.t -> bool
end = struct
let current_unit =
ref ""
current_unit := name
let is name =
!current_unit = name
- let is_name_of id =
- is (Ident.name id)
+ let is_ident id =
+ Ident.persistent id && is (Ident.name id)
+ let is_path = function
+ | Pident id -> is_ident id
+ | Pdot _ | Papply _ -> false
end
let set_unit_name = Current_unit_name.set
match IdTbl.find_same id tbl with
| x -> x
| exception Not_found
- when Ident.persistent id && not (Current_unit_name.is_name_of id) ->
+ when Ident.persistent id && not (Current_unit_name.is_ident id) ->
Mod_persistent
let find_name_module ~mark name tbl =
let add_persistent_structure id env =
if not (Ident.persistent id) then invalid_arg "Env.add_persistent_structure";
- if not (Current_unit_name.is_name_of id) then
- let summary =
+ if Current_unit_name.is_ident id then env
+ else begin
+ let material =
+ (* This addition only observably changes the environment if it shadows a
+ non-persistent module already in the environment.
+ (See PR#9345) *)
match
IdTbl.find_name wrap_module ~mark:false (Ident.name id) env.modules
with
- | exception Not_found | _, Mod_persistent -> env.summary
- | _ -> Env_persistent (env.summary, id)
+ | exception Not_found | _, Mod_persistent -> false
+ | _ -> true
in
- { env with
- modules = IdTbl.add id Mod_persistent env.modules;
- summary
- }
- else
- env
+ let summary =
+ if material then Env_persistent (env.summary, id)
+ else env.summary
+ in
+ let modules =
+ (* With [-no-alias-deps], non-material additions should not
+ affect the environment at all. We should only observe the
+ existence of a cmi when accessing components of the module.
+ (See #9991). *)
+ if material || not !Clflags.transparent_modules then
+ IdTbl.add id Mod_persistent env.modules
+ else
+ env.modules
+ in
+ { env with modules; summary }
+ end
let components_of_module ~alerts ~uid env fs ps path addr mty =
{
let save_sign_of_cmi = sign_of_cmi ~freshen:false
-let persistent_env : module_data Persistent_env.t =
- Persistent_env.empty ()
+let persistent_env : module_data Persistent_env.t ref =
+ s_table Persistent_env.empty ()
let without_cmis f x =
- Persistent_env.without_cmis persistent_env f x
+ Persistent_env.without_cmis !persistent_env f x
-let imports () = Persistent_env.imports persistent_env
+let imports () = Persistent_env.imports !persistent_env
let import_crcs ~source crcs =
- Persistent_env.import_crcs persistent_env ~source crcs
+ Persistent_env.import_crcs !persistent_env ~source crcs
let read_pers_mod modname filename =
- Persistent_env.read persistent_env read_sign_of_cmi modname filename
+ Persistent_env.read !persistent_env read_sign_of_cmi modname filename
let find_pers_mod name =
- Persistent_env.find persistent_env read_sign_of_cmi name
+ Persistent_env.find !persistent_env read_sign_of_cmi name
let check_pers_mod ~loc name =
- Persistent_env.check persistent_env read_sign_of_cmi ~loc name
+ Persistent_env.check !persistent_env read_sign_of_cmi ~loc name
let crc_of_unit name =
- Persistent_env.crc_of_unit persistent_env read_sign_of_cmi name
+ Persistent_env.crc_of_unit !persistent_env read_sign_of_cmi name
let is_imported_opaque modname =
- Persistent_env.is_imported_opaque persistent_env modname
+ Persistent_env.is_imported_opaque !persistent_env modname
let register_import_as_opaque modname =
- Persistent_env.register_import_as_opaque persistent_env modname
+ Persistent_env.register_import_as_opaque !persistent_env modname
let reset_declaration_caches () =
- Types.Uid.Tbl.clear value_declarations;
- Types.Uid.Tbl.clear type_declarations;
- Types.Uid.Tbl.clear module_declarations;
- Types.Uid.Tbl.clear used_constructors;
+ Types.Uid.Tbl.clear !value_declarations;
+ Types.Uid.Tbl.clear !type_declarations;
+ Types.Uid.Tbl.clear !module_declarations;
+ Types.Uid.Tbl.clear !used_constructors;
()
let reset_cache () =
Current_unit_name.set "";
- Persistent_env.clear persistent_env;
+ Persistent_env.clear !persistent_env;
reset_declaration_caches ();
()
let reset_cache_toplevel () =
- Persistent_env.clear_missing persistent_env;
+ Persistent_env.clear_missing !persistent_env;
reset_declaration_caches ();
()
(* get_components *)
let get_components_res c =
- match Persistent_env.can_load_cmis persistent_env with
+ match Persistent_env.can_load_cmis !persistent_env with
| Persistent_env.Can_load_cmis ->
EnvLazy.force !components_of_module_maker' c.comps
| Persistent_env.Cannot_load_cmis log ->
| Papply _ ->
raise Not_found
-let required_globals = ref []
+let required_globals = s_ref []
let reset_required_globals () = required_globals := []
let get_required_globals () = !required_globals
let add_required_global id =
begin match may_subst Subst.module_path sub path with
| Pident id
when Ident.persistent id
- && not (Persistent_env.looked_up persistent_env (Ident.name 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
iter_components (Pident id) path data.mda_components
| Mod_persistent ->
let modname = Ident.name id in
- match Persistent_env.find_in_cache persistent_env modname with
+ match Persistent_env.find_in_cache !persistent_env modname with
| None -> ()
| Some data ->
iter_components (Pident id) path data.mda_components)
env1.types == env2.types && env1.modules == env2.modules
let used_persistent () =
- Persistent_env.fold persistent_env
+ Persistent_env.fold !persistent_env
(fun s _m r -> Concr.add s r)
Concr.empty
| Mp_present ->
EnvLazy.create_forced (Aident id)
+let is_identchar c =
+ (* This should be kept in sync with the [identchar_latin1] character class
+ in [lexer.mll] *)
+ match c with
+ | 'A'..'Z' | 'a'..'z' | '_' | '\192'..'\214'
+ | '\216'..'\246' | '\248'..'\255' | '\'' | '0'..'9' ->
+ true
+ | _ ->
+ false
+
let rec components_of_module_maker
{cm_env; cm_freshening_subst; cm_prefixing_subst;
cm_path; cm_addr; cm_mty} : _ result =
(* Note: we could also check here general validity of the
identifier, to protect against bad identifiers forged by -pp or
-ppx preprocessors. *)
- if String.length name > 0 && (name.[0] = '#') then
+ if String.length name > 0 && not (is_identchar name.[0]) then
for i = 1 to String.length name - 1 do
if name.[i] = '#' then
error (Illegal_value_name(loc, name))
and store_value ?check id addr decl 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)
+ (fun f -> check_usage decl.val_loc id decl.val_uid f !value_declarations)
check;
let vda = { vda_description = decl; vda_address = addr } in
{ env with
if check then
check_usage loc id info.type_uid
(fun s -> Warnings.Unused_type_declaration s)
- type_declarations;
+ !type_declarations;
let path = Pident id in
let constructors =
Datarepr.constructors_of_type path info
let name = cstr.cstr_name in
let loc = cstr.cstr_loc in
let k = cstr.cstr_uid in
- if not (Types.Uid.Tbl.mem used_constructors k) then
+ if not (Types.Uid.Tbl.mem !used_constructors k) then
let used = constructor_usages () in
- Types.Uid.Tbl.add used_constructors k
+ Types.Uid.Tbl.add !used_constructors k
(add_constructor_usage ~rebind:false priv used);
if not (ty_name = "" || ty_name.[0] = '_')
then !add_delayed_check_forward
let is_exception = Path.same ext.ext_type_path Predef.path_exn in
let name = cstr.cstr_name in
let k = cstr.cstr_uid in
- if not (Types.Uid.Tbl.mem used_constructors k) then begin
+ if not (Types.Uid.Tbl.mem !used_constructors k) then begin
let used = constructor_usages () in
- Types.Uid.Tbl.add used_constructors k
+ Types.Uid.Tbl.add !used_constructors k
(add_constructor_usage ~rebind priv used);
!add_delayed_check_forward
(fun () ->
and store_module ~check ~freshening_sub id addr presence md env =
let loc = md.md_loc in
Option.iter
- (fun f -> check_usage loc id md.md_uid f module_declarations) check;
+ (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
Subst.reset_for_saving ();
let sg = Subst.signature Make_local (Subst.for_saving Subst.identity) sg in
let cmi =
- Persistent_env.make_cmi persistent_env modname sg alerts
+ Persistent_env.make_cmi !persistent_env modname sg alerts
|> cmi_transform in
let pm = save_sign_of_cmi
{ Persistent_env.Persistent_signature.cmi; filename } in
- Persistent_env.save_cmi persistent_env
+ Persistent_env.save_cmi !persistent_env
{ Persistent_env.Persistent_signature.filename; cmi } pm;
cmi
(* Tracking usage *)
let mark_module_used uid =
- match Types.Uid.Tbl.find module_declarations uid with
+ match Types.Uid.Tbl.find !module_declarations uid with
| mark -> mark ()
| exception Not_found -> ()
let mark_modtype_used _uid = ()
let mark_value_used uid =
- match Types.Uid.Tbl.find value_declarations uid with
+ match Types.Uid.Tbl.find !value_declarations uid with
| mark -> mark ()
| exception Not_found -> ()
let mark_type_used uid =
- match Types.Uid.Tbl.find type_declarations uid with
+ match Types.Uid.Tbl.find !type_declarations uid with
| mark -> mark ()
| exception Not_found -> ()
| exception Not_found -> ()
let mark_constructor_used usage cd =
- match Types.Uid.Tbl.find used_constructors cd.cd_uid with
+ match Types.Uid.Tbl.find !used_constructors cd.cd_uid with
| mark -> mark usage
| exception Not_found -> ()
let mark_extension_used usage ext =
- match Types.Uid.Tbl.find used_constructors ext.ext_uid with
+ match Types.Uid.Tbl.find !used_constructors ext.ext_uid with
| mark -> mark usage
| exception Not_found -> ()
| _ -> assert false
in
mark_type_path_used env ty_path;
- match Types.Uid.Tbl.find used_constructors cstr.cstr_uid with
+ match Types.Uid.Tbl.find !used_constructors cstr.cstr_uid with
| mark -> mark usage
| exception Not_found -> ()
mark_type_path_used env ty_path
let mark_class_used uid =
- match Types.Uid.Tbl.find type_declarations uid with
+ match Types.Uid.Tbl.find !type_declarations uid with
| mark -> mark ()
| exception Not_found -> ()
let mark_cltype_used uid =
- match Types.Uid.Tbl.find type_declarations uid with
+ match Types.Uid.Tbl.find !type_declarations uid with
| mark -> mark ()
| exception Not_found -> ()
let set_value_used_callback vd callback =
- Types.Uid.Tbl.add value_declarations vd.val_uid callback
+ Types.Uid.Tbl.add !value_declarations vd.val_uid callback
let set_type_used_callback td callback =
if Uid.for_actual_declaration td.type_uid then
let old =
- try Types.Uid.Tbl.find type_declarations td.type_uid
+ try Types.Uid.Tbl.find !type_declarations td.type_uid
with Not_found -> ignore
in
- Types.Uid.Tbl.replace type_declarations td.type_uid (fun () -> callback old)
+ Types.Uid.Tbl.replace !type_declarations td.type_uid
+ (fun () -> callback old)
(* Lookup by name *)
in
f name p md acc
| Mod_persistent ->
- match Persistent_env.find_in_cache persistent_env name with
+ match Persistent_env.find_in_cache !persistent_env name with
| None -> acc
| Some mda ->
let md =
| Mod_local _ -> acc
| Mod_unbound _ -> acc
| Mod_persistent ->
- match Persistent_env.find_in_cache persistent_env name with
+ match Persistent_env.find_in_cache !persistent_env name with
| Some _ -> acc
| None ->
if f (Ident.create_persistent name) then
if Path.Map.is_empty env.local_constraints then env.summary
else Env_constraints (env.summary, env.local_constraints)
-let last_env = ref empty
-let last_reduced_env = ref empty
+let last_env = s_ref empty
+let last_reduced_env = s_ref empty
let keep_only_summary env =
if !last_env == env then !last_reduced_env
| Unbound_type lid ->
fprintf ppf "Unbound type constructor %a" !print_longident lid;
spellcheck ppf extract_types env lid;
- | Unbound_module lid ->
+ | Unbound_module lid -> begin
fprintf ppf "Unbound module %a" !print_longident lid;
- spellcheck ppf extract_modules env lid;
+ match find_modtype_by_name lid env with
+ | exception Not_found -> spellcheck ppf extract_modules env lid;
+ | _ ->
+ fprintf ppf
+ "@.@[%s %a, %s@]"
+ "Hint: There is a module type named"
+ !print_longident lid
+ "but module types are not modules"
+ end
| Unbound_constructor lid ->
fprintf ppf "Unbound constructor %a" !print_longident lid;
spellcheck ppf extract_constructors env lid;
| Unbound_label lid ->
fprintf ppf "Unbound record field %a" !print_longident lid;
spellcheck ppf extract_labels env lid;
- | Unbound_class lid ->
+ | Unbound_class lid -> begin
fprintf ppf "Unbound class %a" !print_longident lid;
- spellcheck ppf extract_classes env lid;
- | Unbound_modtype lid ->
+ match find_cltype_by_name lid env with
+ | exception Not_found -> spellcheck ppf extract_classes env lid;
+ | _ ->
+ fprintf ppf
+ "@.@[%s %a, %s@]"
+ "Hint: There is a class type named"
+ !print_longident lid
+ "but classes are not class types"
+ end
+ | Unbound_modtype lid -> begin
fprintf ppf "Unbound module type %a" !print_longident lid;
- spellcheck ppf extract_modtypes env lid;
+ match find_module_by_name lid env with
+ | exception Not_found -> spellcheck ppf extract_modtypes env lid;
+ | _ ->
+ fprintf ppf
+ "@.@[%s %a, %s@]"
+ "Hint: There is a module named"
+ !print_longident lid
+ "but modules are not module types"
+ end
| Unbound_cltype lid ->
fprintf ppf "Unbound class type %a" !print_longident lid;
spellcheck ppf extract_cltypes env lid;
fprintf ppf "@[The functor %a is generative,@ it@ cannot@ be@ \
applied@ in@ type@ expressions@]" !print_longident lid
| Cannot_scrape_alias(lid, p) ->
+ let cause =
+ if Current_unit_name.is_path p then "is the current compilation unit"
+ else "is missing"
+ in
fprintf ppf
- "The module %a is an alias for module %a, which is missing"
- !print_longident lid !print_path p
+ "The module %a is an alias for module %a, which %s"
+ !print_longident lid !print_path p cause
let report_error ppf = function
| Missing_module(_, path1, path2) ->
(** Folds *)
+val fold_values:
+ (string -> Path.t -> value_description -> 'a -> 'a) ->
+ Longident.t option -> t -> 'a -> 'a
+val fold_types:
+ (string -> Path.t -> type_declaration -> 'a -> 'a) ->
+ Longident.t option -> t -> 'a -> 'a
val fold_constructors:
(constructor_description -> 'a -> 'a) ->
Longident.t option -> t -> 'a -> 'a
+val fold_labels:
+ (label_description -> 'a -> 'a) ->
+ Longident.t option -> t -> 'a -> 'a
+
+(** Persistent structures are only traversed if they are already loaded. *)
+val fold_modules:
+ (string -> Path.t -> module_declaration -> 'a -> 'a) ->
+ Longident.t option -> t -> 'a -> 'a
+
+val fold_modtypes:
+ (string -> Path.t -> modtype_declaration -> 'a -> 'a) ->
+ Longident.t option -> t -> 'a -> 'a
+val fold_classes:
+ (string -> Path.t -> class_declaration -> 'a -> 'a) ->
+ Longident.t option -> t -> 'a -> 'a
+val fold_cltypes:
+ (string -> Path.t -> class_type_declaration -> 'a -> 'a) ->
+ Longident.t option -> t -> 'a -> 'a
+
(** Utilities *)
val scrape_alias: t -> module_type -> module_type
(* *)
(**************************************************************************)
+open Local_store
+
let lowest_scope = 0
let highest_scope = 100000000
(* A stamp of 0 denotes a persistent identifier *)
-let currentstamp = ref 0
-let predefstamp = ref 0
+let currentstamp = s_ref 0
+let predefstamp = s_ref 0
let create_scoped ~scope s =
incr currentstamp;
val rename: t -> t
(** Creates an identifier with the same name as the input, a fresh
stamp, and no scope.
- @raises [Fatal_error] if called on a persistent / predef ident. *)
+ @raise [Fatal_error] if called on a persistent / predef ident. *)
val name: t -> string
val unique_name: t -> string
Sig_class_type(id, Ctype.nondep_cltype_declaration env ids d, rs, vis)
and nondep_sig env va ids sg =
+ let scope = Ctype.create_scope () in
+ let sg, env = Env.enter_signature ~scope sg env in
List.map (nondep_sig_item env va ids) sg
and nondep_modtype_decl env ids mtd =
let print_type_parameter ppf s =
if s = "_" then fprintf ppf "_" else pr_var ppf s
-let type_parameter ppf (ty, (co, cn)) =
- fprintf ppf "%s%a"
- (if not cn then "+" else if not co then "-" else "")
+let type_parameter ppf (ty, (var, inj)) =
+ let open Asttypes in
+ fprintf ppf "%s%s%a"
+ (match var with Covariant -> "+" | Contravariant -> "-" | NoVariance -> "")
+ (match inj with Injective -> "!" | NoInjectivity -> "")
print_type_parameter ty
let print_out_class_params ppf =
| Oval_tuple of out_value list
| Oval_variant of string * out_value option
+type out_type_param = string * (Asttypes.variance * Asttypes.injectivity)
+
type out_type =
| Otyp_abstract
| Otyp_open
| Omty_alias of out_ident
and out_sig_item =
| Osig_class of
- bool * string * (string * (bool * bool)) list * out_class_type *
+ bool * string * out_type_param list * out_class_type *
out_rec_status
| Osig_class_type of
- bool * string * (string * (bool * bool)) list * out_class_type *
+ bool * string * out_type_param list * out_class_type *
out_rec_status
| Osig_typext of out_extension_constructor * out_ext_status
| Osig_modtype of string * out_module_type
| Osig_ellipsis
and out_type_decl =
{ otype_name: string;
- otype_params: (string * (bool * bool)) list;
+ otype_params: out_type_param list;
otype_type: out_type;
otype_private: Asttypes.private_flag;
otype_immediate: Type_immediacy.t;
open Types
open Typedtree
+
(*************************************)
(* Utilities for building patterns *)
(*************************************)
pat_attributes = [];
}
-let omega = make_pat Tpat_any Ctype.none Env.empty
+let omega = Patterns.omega
+let omegas = Patterns.omegas
+let omega_list = Patterns.omega_list
let extra_pat =
make_pat
(Tpat_var (Ident.create_local "+", mknoloc "+"))
Ctype.none Env.empty
-let rec omegas i =
- if i <= 0 then [] else omega :: omegas (i-1)
-
-let omega_list l = List.map (fun _ -> omega) l
-
-module Pattern_head : sig
- type desc =
- | Any
- | Construct of constructor_description
- | Constant of constant
- | Tuple of int
- | Record of label_description list
- | Variant of
- { tag: label; has_arg: bool;
- cstr_row: row_desc ref;
- type_row : unit -> row_desc; }
- (* the row of the type may evolve if [close_variant] is called,
- hence the (unit -> ...) delay *)
- | Array of int
- | Lazy
-
- type t
-
- val desc : t -> desc
- val env : t -> Env.t
- val loc : t -> Location.t
- val typ : t -> Types.type_expr
-
- (** [deconstruct p] returns the head of [p] and the list of sub patterns.
-
- @raises [Invalid_arg _] if [p] is an or- or an exception-pattern. *)
- val deconstruct : pattern -> t * pattern list
-
- (** reconstructs a pattern, putting wildcards as sub-patterns. *)
- val to_omega_pattern : t -> pattern
-
- val make
- : loc:Location.t
- -> typ:Types.type_expr
- -> env:Env.t
- -> desc
- -> t
-
- val omega : t
-
-end = struct
- type desc =
- | Any
- | Construct of constructor_description
- | Constant of constant
- | Tuple of int
- | Record of label_description list
- | Variant of
- { tag: label;
- has_arg: bool;
- cstr_row: row_desc ref;
- type_row: unit -> row_desc; }
- | Array of int
- | Lazy
-
- type t = {
- desc: desc;
- typ : Types.type_expr;
- loc : Location.t;
- env : Env.t;
- attributes : attributes;
- }
-
- let desc { desc } = desc
- let env { env } = env
- let loc { loc } = loc
- let typ { typ } = typ
-
- let deconstruct q =
- let rec deconstruct_desc = function
- | Tpat_any
- | Tpat_var _ -> Any, []
- | Tpat_constant c -> Constant c, []
- | Tpat_alias (p,_,_) -> deconstruct_desc p.pat_desc
- | Tpat_tuple args ->
- Tuple (List.length args), args
- | Tpat_construct (_, c, args) ->
- Construct c, args
- | Tpat_variant (tag, arg, cstr_row) ->
- let has_arg, pats =
- match arg with
- | None -> false, []
- | Some a -> true, [a]
- in
- let type_row () =
- match Ctype.expand_head q.pat_env q.pat_type with
- | {desc = Tvariant type_row} -> Btype.row_repr type_row
- | _ -> assert false
- in
- Variant {tag; has_arg; cstr_row; type_row}, pats
- | Tpat_array args ->
- Array (List.length args), args
- | Tpat_record (largs, _) ->
- let lbls = List.map (fun (_,lbl,_) -> lbl) largs in
- let pats = List.map (fun (_,_,pat) -> pat) largs in
- Record lbls, pats
- | Tpat_lazy p ->
- Lazy, [p]
- | Tpat_or _ -> invalid_arg "Parmatch.Pattern_head.deconstruct: (P | Q)"
- in
- let desc, pats = deconstruct_desc q.pat_desc in
- { desc; typ = q.pat_type; loc = q.pat_loc;
- env = q.pat_env; attributes = q.pat_attributes }, pats
-
- let to_omega_pattern t =
- let pat_desc =
- match t.desc with
- | Any -> Tpat_any
- | Lazy -> Tpat_lazy omega
- | Constant c -> Tpat_constant c
- | Tuple n -> Tpat_tuple (omegas n)
- | Array n -> Tpat_array (omegas n)
- | Construct c ->
- let lid_loc = Location.mkloc (Longident.Lident c.cstr_name) t.loc in
- Tpat_construct (lid_loc, c, omegas c.cstr_arity)
- | Variant { tag; has_arg; cstr_row } ->
- let arg_opt = if has_arg then Some omega else None in
- Tpat_variant (tag, arg_opt, cstr_row)
- | Record lbls ->
- let lst =
- List.map (fun lbl ->
- let lid_loc =
- Location.mkloc (Longident.Lident lbl.lbl_name) t.loc
- in
- (lid_loc, lbl, omega)
- ) lbls
- in
- Tpat_record (lst, Closed)
- in
- { pat_desc; pat_type = t.typ; pat_loc = t.loc; pat_extra = [];
- pat_env = t.env; pat_attributes = t.attributes }
-
- let make ~loc ~typ ~env desc =
- { desc; loc; typ; env; attributes = [] }
-
- let omega =
- { desc = Any
- ; loc = Location.none
- ; typ = Ctype.none
- ; env = Env.empty
- ; attributes = []
- }
-end
-
-(*
- Normalize a pattern ->
- all arguments are omega (simple pattern) and no more variables
-*)
-
-let normalize_pat p = Pattern_head.(to_omega_pattern @@ fst @@ deconstruct p)
(*******************)
(* Coherence check *)
check that every other head pattern in the column is coherent with that one.
*)
let all_coherent column =
+ let open Patterns.Head in
let coherent_heads hp1 hp2 =
- match Pattern_head.desc hp1, Pattern_head.desc hp2 with
+ match hp1.pat_desc, hp2.pat_desc with
| Construct c, Construct c' ->
c.cstr_consts = c'.cstr_consts
&& c.cstr_nonconsts = c'.cstr_nonconsts
| _, _ -> false
in
match
- List.find (fun head_pat ->
- match Pattern_head.desc head_pat with
- | Any -> false
- | _ -> true
- ) column
+ List.find
+ (function
+ | { pat_desc = Any } -> false
+ | _ -> true)
+ column
with
| exception Not_found ->
(* only omegas on the column: the column is coherent. *)
let is_absent tag row = Btype.row_field tag !row = Rabsent
let is_absent_pat d =
- match Pattern_head.desc d with
- | Variant { tag; cstr_row; _ } -> is_absent tag cstr_row
+ match d.pat_desc with
+ | Patterns.Head.Variant { tag; cstr_row; _ } -> is_absent tag cstr_row
| _ -> false
let const_compare x y =
(* Check top matching *)
let simple_match d h =
- match Pattern_head.desc d, Pattern_head.desc h with
+ let open Patterns.Head in
+ match d.pat_desc, h.pat_desc with
| Construct c1, Construct c2 ->
Types.equal_tag c1.cstr_tag c2.cstr_tag
| Variant { tag = t1; _ }, Variant { tag = t2 } ->
(* extract record fields as a whole *)
-let record_arg ph = match Pattern_head.desc ph with
-| Any -> []
-| Record args -> args
-| _ -> fatal_error "Parmatch.as_record"
+let record_arg ph =
+ let open Patterns.Head in
+ match ph.pat_desc with
+ | Any -> []
+ | Record args -> args
+ | _ -> fatal_error "Parmatch.as_record"
let extract_fields lbls arg =
List.map (fun lbl -> get_field lbl.lbl_pos arg) lbls
(* Build argument list when p2 >= p1, where p1 is a simple pattern *)
-let simple_match_args discr head args = match Pattern_head.desc head with
-| Constant _ -> []
-| Construct _
-| Variant _
-| Tuple _
-| Array _
-| Lazy -> args
-| Record lbls -> extract_fields (record_arg discr) (List.combine lbls args)
-| Any ->
- begin match Pattern_head.desc discr with
- | Construct cstr -> omegas cstr.cstr_arity
- | Variant { has_arg = true }
- | Lazy -> [omega]
- | Record lbls -> omega_list lbls
- | Array len
- | Tuple len -> omegas len
- | Variant { has_arg = false }
- | Any
- | Constant _ -> []
- end
+let simple_match_args discr head args =
+ let open Patterns.Head in
+ match head.pat_desc with
+ | Constant _ -> []
+ | Construct _
+ | Variant _
+ | Tuple _
+ | Array _
+ | Lazy -> args
+ | Record lbls -> extract_fields (record_arg discr) (List.combine lbls args)
+ | Any ->
+ begin match discr.pat_desc with
+ | Construct cstr -> Patterns.omegas cstr.cstr_arity
+ | Variant { has_arg = true }
+ | Lazy -> [Patterns.omega]
+ | Record lbls -> omega_list lbls
+ | Array len
+ | Tuple len -> Patterns.omegas len
+ | Variant { has_arg = false }
+ | Any
+ | Constant _ -> []
+ end
(* Consider a pattern matrix whose first column has been simplified to contain
only _ or a head constructor
stop and return our accumulator.
*)
let discr_pat q pss =
+ let open Patterns.Head in
let rec refine_pat acc = function
| [] -> acc
| ((head, _), _) :: rows ->
- match Pattern_head.desc head with
+ match head.pat_desc with
| Any -> refine_pat acc rows
| Tuple _ | Lazy -> head
| Record lbls ->
lbl :: r
) lbls (record_arg acc)
in
- let d =
- let open Pattern_head in
- make ~loc:(loc head) ~typ:(typ head) ~env:(env head) (Record fields)
- in
+ let d = { head with pat_desc = Record fields } in
refine_pat d rows
| _ -> acc
in
- let q, _ = Pattern_head.deconstruct q in
- match Pattern_head.desc q with
+ let q, _ = deconstruct q in
+ match q.pat_desc with
(* short-circuiting: clearly if we have anything other than [Record] or
[Any] to start with, we're not going to be able refine at all. So
there's no point going over the matrix. *)
*)
let simplify_head_pat ~add_column p ps k =
let rec simplify_head_pat p ps k =
- match p.pat_desc with
- | Tpat_alias (p,_,_) ->
- (* We have to handle aliases here, because there can be or-patterns
- underneath, that [Pattern_head.deconstruct] won't handle. *)
- simplify_head_pat p ps k
- | Tpat_or (p1,p2,_) -> simplify_head_pat p1 ps (simplify_head_pat p2 ps k)
- | _ -> add_column (Pattern_head.deconstruct p) ps k
+ match Patterns.General.(view p |> strip_vars).pat_desc with
+ | `Or (p1,p2,_) -> simplify_head_pat p1 ps (simplify_head_pat p2 ps k)
+ | #Patterns.Simple.view as view ->
+ add_column (Patterns.Head.deconstruct { p with pat_desc = view }) ps k
in simplify_head_pat p ps k
let rec simplify_first_col = function
*)
type 'matrix specialized_matrices = {
default : 'matrix;
- constrs : (Pattern_head.t * 'matrix) list;
+ constrs : (Patterns.Head.t * 'matrix) list;
}
(* Consider a pattern matrix whose first column has been simplified
(discr, r :: rs)
in
- (* insert a row of head [p] and rest [r] into the right group *)
+ (* insert a row of head [p] and rest [r] into the right group
+
+ Note: with this implementation, the order of the groups
+ is the order of their first row in the source order.
+ This is a nice property to get exhaustivity counter-examples
+ in source order.
+ *)
let rec insert_constr head args r = function
| [] ->
(* if no group matched this row, it has a head constructor that
(* insert a row of head omega into all groups *)
let insert_omega r env =
- List.map (fun (q0,rs) -> extend_group q0 Pattern_head.omega [] r rs) env
+ List.map (fun (q0,rs) -> extend_group q0 Patterns.Head.omega [] r rs) env
in
let rec form_groups constr_groups omega_tails = function
| [] -> (constr_groups, omega_tails)
| ((head, args), tail) :: rest ->
- match Pattern_head.desc head with
- | Any ->
+ match head.pat_desc with
+ | Patterns.Head.Any ->
(* note that calling insert_omega here would be wrong
as some groups may not have been formed yet, if the
first row with this head pattern comes after in the list *)
let constr_groups, omega_tails =
let initial_constr_group =
- match Pattern_head.desc discr with
+ let open Patterns.Head in
+ match discr.pat_desc with
| Record _ | Tuple _ | Lazy ->
(* [discr] comes from [discr_pat], and in this case subsumes any of the
patterns we could find on the first column of [rows]. So it is better
in
form_groups initial_constr_group [] rows
in
- {
- default = omega_tails;
- constrs =
- (* insert omega rows in all groups *)
- List.fold_right insert_omega omega_tails constr_groups;
- }
+
+ (* groups are accumulated in reverse order;
+ we restore the order of rows in the source code *)
+ let default = List.rev omega_tails in
+ let constrs =
+ List.fold_right insert_omega omega_tails constr_groups
+ |> List.map (fun (discr, rs) -> (discr, List.rev rs))
+ in
+ { default; constrs; }
(* Variant related functions *)
let set_last a =
let rec loop = function
| [] -> assert false
- | [_] -> [a]
+ | [_] -> [Patterns.General.erase a]
| x::l -> x :: loop l
in
function
- | (_, []) -> (Pattern_head.deconstruct a, [])
+ | (_, []) -> (Patterns.Head.deconstruct a, [])
| (first, row) -> (first, loop row)
(* mark constructor lines for failure when they are incomplete *)
let mark_partial =
- let zero = make_pat (Tpat_constant (Const_int 0)) Ctype.none Env.empty in
+ let zero = make_pat (`Constant (Const_int 0)) Ctype.none Env.empty in
List.map (fun ((hp, _), _ as ps) ->
- match Pattern_head.desc hp with
- | Any -> ps
+ match hp.pat_desc with
+ | Patterns.Head.Any -> ps
| _ -> set_last zero ps
)
let full_match closing env = match env with
| [] -> false
| (discr, _) :: _ ->
- match Pattern_head.desc discr with
+ let open Patterns.Head in
+ match discr.pat_desc with
| Any -> assert false
| Construct { cstr_tag = Cstr_extension _ ; _ } -> false
| Construct c -> List.length env = c.cstr_consts + c.cstr_nonconsts
let fields =
List.map
(fun (d, _) ->
- match Pattern_head.desc d with
+ match d.pat_desc with
| Variant { tag } -> tag
| _ -> assert false)
env
| Some ext -> begin match env with
| [] -> assert false
| (p,_)::_ ->
- begin match Pattern_head.desc p with
+ let open Patterns.Head in
+ begin match p.pat_desc with
| Construct {cstr_tag=(Cstr_constant _|Cstr_block _|Cstr_unboxed)} ->
- let path =
- get_constructor_type_path (Pattern_head.typ p) (Pattern_head.env p)
- in
+ let path = get_constructor_type_path p.pat_type p.pat_env in
Path.same path ext
| Construct {cstr_tag=(Cstr_extension _)} -> false
| Constant _ | Tuple _ | Variant _ | Record _ | Array _ | Lazy -> false
(* build an or-pattern from a constructor list *)
let pat_of_constrs ex_pat cstrs =
- let ex_pat = Pattern_head.to_omega_pattern ex_pat in
+ let ex_pat = Patterns.Head.to_omega_pattern ex_pat in
if cstrs = [] then raise Empty else
orify_many (List.map (pat_of_constr ex_pat) cstrs)
| _ -> fatal_error "Parmatch.get_variant_constructors"
(* Sends back a pattern that complements constructor tags all_tag *)
-let complete_constrs p all_tags =
- let c = match Pattern_head.desc p with Construct c -> c | _ -> assert false in
+let complete_constrs constr all_tags =
+ let c = constr.pat_desc in
let not_tags = complete_tags c.cstr_consts c.cstr_nonconsts all_tags in
- let constrs = get_variant_constructors (Pattern_head.env p) c.cstr_res in
+ let constrs = get_variant_constructors constr.pat_env c.cstr_res in
let others =
List.filter
(fun cnstr -> ConstructorTagHashtbl.mem not_tags cnstr.cstr_tag)
const @ nonconst
let build_other_constrs env p =
- match Pattern_head.desc p with
- | Construct { cstr_tag = Cstr_constant _ | Cstr_block _ } ->
+ let open Patterns.Head in
+ match p.pat_desc with
+ | Construct ({ cstr_tag = Cstr_constant _ | Cstr_block _ } as c) ->
+ let constr = { p with pat_desc = c } in
let get_tag q =
- match Pattern_head.desc q with
+ match q.pat_desc with
| Construct c -> c.cstr_tag
| _ -> fatal_error "Parmatch.get_tag" in
let all_tags = List.map (fun (p,_) -> get_tag p) env in
- pat_of_constrs p (complete_constrs p all_tags)
+ pat_of_constrs p (complete_constrs constr all_tags)
| _ -> extra_pat
-let complete_constrs p all_tags =
- (* This wrapper is here for [Matching], which (indirectly) calls this function
- from [combine_constructor], and nowhere else.
- So we know patterns have been fully simplified. *)
- complete_constrs (fst @@ Pattern_head.deconstruct p) all_tags
-
(* Auxiliary for build_other *)
let build_other_constant proj make first next p env =
- let all = List.map (fun (p, _) -> proj (Pattern_head.desc p)) env in
+ let all = List.map (fun (p, _) -> proj p.pat_desc) env in
let rec try_const i =
if List.mem i all
then try_const (next i)
- else make_pat (make i) (Pattern_head.typ p) (Pattern_head.env p)
+ else make_pat (make i) p.pat_type p.pat_env
in try_const first
(*
match env with
| [] -> omega
| (d, _) :: _ ->
- match Pattern_head.desc d with
+ let open Patterns.Head in
+ match d.pat_desc with
| Construct { cstr_tag = Cstr_extension _ } ->
(* let c = {c with cstr_name = "*extension*"} in *) (* PR#7330 *)
make_pat
(Tpat_var (Ident.create_local "*extension*",
- {txt="*extension*"; loc = Pattern_head.loc d}))
+ {txt="*extension*"; loc = d.pat_loc}))
Ctype.none Env.empty
| Construct _ ->
begin match ext with
| Some ext ->
- if Path.same ext
- (get_constructor_type_path
- (Pattern_head.typ d) (Pattern_head.env d))
+ if Path.same ext (get_constructor_type_path d.pat_type d.pat_env)
then
extra_pat
else
let tags =
List.map
(fun (d, _) ->
- match Pattern_head.desc d with
+ match d.pat_desc with
| Variant { tag } -> tag
| _ -> assert false)
env
in
let make_other_pat tag const =
- let arg = if const then None else Some omega in
- make_pat (Tpat_variant(tag, arg, cstr_row))
- (Pattern_head.typ d) (Pattern_head.env d)
+ let arg = if const then None else Some Patterns.omega in
+ make_pat (Tpat_variant(tag, arg, cstr_row)) d.pat_type d.pat_env
in
let row = type_row () in
begin match
| pat::other_pats ->
List.fold_left
(fun p_res pat ->
- make_pat (Tpat_or (pat, p_res, None))
- (Pattern_head.typ d) (Pattern_head.env d))
+ make_pat (Tpat_or (pat, p_res, None)) d.pat_type d.pat_env)
pat other_pats
end
| Constant Const_char _ ->
let all_chars =
List.map
- (fun (p,_) -> match Pattern_head.desc p with
+ (fun (p,_) -> match p.pat_desc with
| Constant (Const_char c) -> c
| _ -> assert false)
env
if List.mem ci all_chars then
find_other (i+1) imax
else
- make_pat (Tpat_constant (Const_char ci))
- (Pattern_head.typ d) (Pattern_head.env d)
+ make_pat (Tpat_constant (Const_char ci)) d.pat_type d.pat_env
in
let rec try_chars = function
- | [] -> omega
+ | [] -> Patterns.omega
| (c1,c2) :: rest ->
try
find_other (Char.code c1) (Char.code c2)
| Array _ ->
let all_lengths =
List.map
- (fun (p,_) -> match Pattern_head.desc p with
+ (fun (p,_) -> match p.pat_desc with
| Array len -> len
| _ -> assert false)
env in
let rec try_arrays l =
if List.mem l all_lengths then try_arrays (l+1)
else
- make_pat
- (Tpat_array (omegas l))
- (Pattern_head.typ d) (Pattern_head.env d) in
+ make_pat (Tpat_array (omegas l)) d.pat_type d.pat_env in
try_arrays 0
- | _ -> omega
+ | _ -> Patterns.omega
let rec has_instance p = match p.pat_desc with
| Tpat_variant (l,_,r) when is_absent l r -> false
| _ ->
match qs with
| [] -> false
- | {pat_desc = Tpat_or(q1,q2,_)}::qs ->
- satisfiable pss (q1::qs) || satisfiable pss (q2::qs)
- | {pat_desc = Tpat_alias(q,_,_)}::qs ->
- satisfiable pss (q::qs)
- | {pat_desc = (Tpat_any | Tpat_var(_))}::qs ->
- let pss = simplify_first_col pss in
- if not (all_coherent (first_column pss)) then
- false
- else begin
- let { default; constrs } =
- let q0 = discr_pat omega pss in
- build_specialized_submatrices ~extend_row:(@) q0 pss in
- if not (full_match false constrs) then
- satisfiable default qs
- else
- List.exists
- (fun (p,pss) ->
- not (is_absent_pat p) &&
- satisfiable pss
- (simple_match_args p Pattern_head.omega [] @ qs))
- constrs
- end
- | {pat_desc=Tpat_variant (l,_,r)}::_ when is_absent l r -> false
| q::qs ->
- let pss = simplify_first_col pss in
- let hq, qargs = Pattern_head.deconstruct q in
- if not (all_coherent (hq :: first_column pss)) then
- false
- else begin
- let q0 = discr_pat q pss in
- satisfiable (build_specialized_submatrix ~extend_row:(@) q0 pss)
- (simple_match_args q0 hq qargs @ qs)
- end
+ match Patterns.General.(view q |> strip_vars).pat_desc with
+ | `Or(q1,q2,_) ->
+ satisfiable pss (q1::qs) || satisfiable pss (q2::qs)
+ | `Any ->
+ let pss = simplify_first_col pss in
+ if not (all_coherent (first_column pss)) then
+ false
+ else begin
+ let { default; constrs } =
+ let q0 = discr_pat Patterns.Simple.omega pss in
+ build_specialized_submatrices ~extend_row:(@) q0 pss in
+ if not (full_match false constrs) then
+ satisfiable default qs
+ else
+ List.exists
+ (fun (p,pss) ->
+ not (is_absent_pat p) &&
+ satisfiable pss
+ (simple_match_args p Patterns.Head.omega [] @ qs))
+ constrs
+ end
+ | `Variant (l,_,r) when is_absent l r -> false
+ | #Patterns.Simple.view as view ->
+ let q = { q with pat_desc = view } in
+ let pss = simplify_first_col pss in
+ let hq, qargs = Patterns.Head.deconstruct q in
+ if not (all_coherent (hq :: first_column pss)) then
+ false
+ else begin
+ let q0 = discr_pat q pss in
+ satisfiable (build_specialized_submatrix ~extend_row:(@) q0 pss)
+ (simple_match_args q0 hq qargs @ qs)
+ end
(* While [satisfiable] only checks whether the last row of [pss + qs] is
satisfiable, this function returns the (possibly empty) list of vectors [es]
| _ ->
match qs with
| [] -> []
- | {pat_desc = Tpat_or(q1,q2,_)}::qs ->
- list_satisfying_vectors pss (q1::qs) @
- list_satisfying_vectors pss (q2::qs)
- | {pat_desc = Tpat_alias(q,_,_)}::qs ->
- list_satisfying_vectors pss (q::qs)
- | {pat_desc = (Tpat_any | Tpat_var(_))}::qs ->
- let pss = simplify_first_col pss in
- if not (all_coherent (first_column pss)) then
- []
- else begin
- let q0 = discr_pat omega pss in
- let wild default_matrix p =
- List.map (fun qs -> p::qs)
- (list_satisfying_vectors default_matrix qs)
- in
- match build_specialized_submatrices ~extend_row:(@) q0 pss with
- | { default; constrs = [] } ->
- (* first column of pss is made of variables only *)
- wild default omega
- | { default; constrs = ((p,_)::_ as constrs) } ->
- let for_constrs () =
- List.flatten (
- List.map (fun (p,pss) ->
- if is_absent_pat p then
- []
- else
- let witnesses =
- list_satisfying_vectors pss
- (simple_match_args p Pattern_head.omega [] @ qs)
- in
- let p = Pattern_head.to_omega_pattern p in
- List.map (set_args p) witnesses
- ) constrs
- )
- in
- if full_match false constrs then for_constrs () else
- begin match Pattern_head.desc p with
- | Construct _ ->
- (* activate this code for checking non-gadt constructors *)
- wild default (build_other_constrs constrs p)
- @ for_constrs ()
- | _ ->
- wild default omega
- end
+ | q :: qs ->
+ match Patterns.General.(view q |> strip_vars).pat_desc with
+ | `Or(q1,q2,_) ->
+ list_satisfying_vectors pss (q1::qs) @
+ list_satisfying_vectors pss (q2::qs)
+ | `Any ->
+ let pss = simplify_first_col pss in
+ if not (all_coherent (first_column pss)) then
+ []
+ else begin
+ let q0 = discr_pat Patterns.Simple.omega pss in
+ let wild default_matrix p =
+ List.map (fun qs -> p::qs)
+ (list_satisfying_vectors default_matrix qs)
+ in
+ match build_specialized_submatrices ~extend_row:(@) q0 pss with
+ | { default; constrs = [] } ->
+ (* first column of pss is made of variables only *)
+ wild default omega
+ | { default; constrs = ((p,_)::_ as constrs) } ->
+ let for_constrs () =
+ List.flatten (
+ List.map (fun (p,pss) ->
+ if is_absent_pat p then
+ []
+ else
+ let witnesses =
+ list_satisfying_vectors pss
+ (simple_match_args p Patterns.Head.omega [] @ qs)
+ in
+ let p = Patterns.Head.to_omega_pattern p in
+ List.map (set_args p) witnesses
+ ) constrs
+ )
+ in
+ if full_match false constrs then for_constrs () else
+ begin match p.pat_desc with
+ | Construct _ ->
+ (* activate this code
+ for checking non-gadt constructors *)
+ wild default (build_other_constrs constrs p)
+ @ for_constrs ()
+ | _ ->
+ wild default Patterns.omega
+ end
end
- | {pat_desc=Tpat_variant (l,_,r)}::_ when is_absent l r -> []
- | q::qs ->
- let hq, qargs = Pattern_head.deconstruct q in
+ | `Variant (l, _, r) when is_absent l r -> []
+ | #Patterns.Simple.view as view ->
+ let q = { q with pat_desc = view } in
+ let hq, qargs = Patterns.Head.deconstruct q in
let pss = simplify_first_col pss in
if not (all_coherent (hq :: first_column pss)) then
[]
else begin
let q0 = discr_pat q pss in
- List.map (set_args (Pattern_head.to_omega_pattern q0))
+ List.map (set_args (Patterns.Head.to_omega_pattern q0))
(list_satisfying_vectors
(build_specialized_submatrix ~extend_row:(@) q0 pss)
(simple_match_args q0 hq qargs @ qs))
| []::_ -> true
| _ -> false
end
-| q::qs -> match q with
- | {pat_desc = Tpat_or (q1,q2,_)} ->
+| q::qs -> match Patterns.General.(view q |> strip_vars).pat_desc with
+ | `Or (q1,q2,_) ->
do_match pss (q1::qs) || do_match pss (q2::qs)
- | {pat_desc = Tpat_any} ->
+ | `Any ->
let rec remove_first_column = function
| (_::ps)::rem -> ps::remove_first_column rem
| _ -> []
in
do_match (remove_first_column pss) qs
- | _ ->
- (* [q] is generated by us, it doesn't come from the source. So we know
- it's not of the form [P as name].
- Therefore there is no risk of [deconstruct] raising. *)
- let q0, qargs = Pattern_head.deconstruct q in
+ | #Patterns.Simple.view as view ->
+ let q = { q with pat_desc = view } in
+ let q0, qargs = Patterns.Head.deconstruct q in
let pss = simplify_first_col pss in
(* [pss] will (or won't) match [q0 :: qs] regardless of the coherence of
its first column. *)
(build_specialized_submatrix ~extend_row:(@) q0 pss)
(qargs @ qs)
-
-type 'a exhaust_result =
- | No_matching_value
- | Witnesses of 'a list
-
-let rappend r1 r2 =
- match r1, r2 with
- | No_matching_value, _ -> r2
- | _, No_matching_value -> r1
- | Witnesses l1, Witnesses l2 -> Witnesses (l1 @ l2)
-
-let rec try_many f = function
- | [] -> No_matching_value
- | (p,pss)::rest ->
- rappend (f (p, pss)) (try_many f rest)
-
(*
let print_pat pat =
let rec string_of_pat pat =
This function should be called for exhaustiveness check only.
*)
let rec exhaust (ext:Path.t option) pss n = match pss with
-| [] -> Witnesses [omegas n]
-| []::_ -> No_matching_value
-| pss ->
- let pss = simplify_first_col pss in
- if not (all_coherent (first_column pss)) then
- (* We're considering an ill-typed branch, we won't actually be able to
- produce a well typed value taking that branch. *)
- No_matching_value
- else begin
- (* Assuming the first column is ill-typed but considered coherent, we
- might end up producing an ill-typed witness of non-exhaustivity
- corresponding to the current branch.
-
- If [exhaust] has been called by [do_check_partial], then the witnesses
- produced get typechecked and the ill-typed ones are discarded.
-
- If [exhaust] has been called by [do_check_fragile], then it is possible
- we might fail to warn the user that the matching is fragile. See for
- example testsuite/tests/warnings/w04_failure.ml. *)
- let q0 = discr_pat omega pss in
- match build_specialized_submatrices ~extend_row:(@) q0 pss with
- | { default; constrs = [] } ->
- (* first column of pss is made of variables only *)
- begin match exhaust ext default (n-1) with
- | Witnesses r ->
- let q0 = Pattern_head.to_omega_pattern q0 in
- Witnesses (List.map (fun row -> q0::row) r)
- | r -> r
- end
- | { default; constrs } ->
- let try_non_omega (p,pss) =
- if is_absent_pat p then
- No_matching_value
- else
- match
- exhaust
- ext pss
- (List.length (simple_match_args p Pattern_head.omega [])
- + n - 1)
- with
- | Witnesses r ->
- let p = Pattern_head.to_omega_pattern p in
- Witnesses (List.map (set_args p) r)
- | r -> r in
- let before = try_many try_non_omega constrs in
- if
- full_match false constrs && not (should_extend ext constrs)
- then
- before
+| [] -> Seq.return (omegas n)
+| []::_ -> Seq.empty
+| [(p :: ps)] -> exhaust_single_row ext p ps n
+| pss -> specialize_and_exhaust ext pss n
+
+and exhaust_single_row ext p ps n =
+ (* Shortcut: in the single-row case p :: ps we know that all
+ counter-examples are either of the form
+ counter-example(p) :: omegas
+ or
+ p :: counter-examples(ps)
+
+ This is very interesting in the case where p contains
+ or-patterns, as the non-shortcut path below would do a separate
+ search for each constructor of the or-pattern, which can lead to
+ an exponential blowup on examples such as
+
+ | (A|B), (A|B), (A|B), (A|B) -> foo
+
+ Note that this shortcut also applies to examples such as
+
+ | A, A, A, A -> foo | (A|B), (A|B), (A|B), (A|B) -> bar
+
+ thanks to the [get_mins] preprocessing step which will drop the
+ first row (subsumed by the second). Code with this shape does
+ occur naturally when people want to avoid fragile pattern
+ matches: if A and B are the only two constructors, this is the
+ best way to make a non-fragile distinction between "all As" and
+ "at least one B".
+ *)
+ List.to_seq [Some p; None] |> Seq.flat_map
+ (function
+ | Some p ->
+ let sub_witnesses = exhaust ext [ps] (n - 1) in
+ Seq.map (fun row -> p :: row) sub_witnesses
+ | None ->
+ (* note: calling [exhaust] recursively of p would
+ result in an infinite loop in the case n=1 *)
+ let p_witnesses = specialize_and_exhaust ext [[p]] 1 in
+ Seq.map (fun p_row -> p_row @ omegas (n - 1)) p_witnesses
+ )
+
+and specialize_and_exhaust ext pss n =
+ let pss = simplify_first_col pss in
+ if not (all_coherent (first_column pss)) then
+ (* We're considering an ill-typed branch, we won't actually be able to
+ produce a well typed value taking that branch. *)
+ Seq.empty
+ else begin
+ (* Assuming the first column is ill-typed but considered coherent, we
+ might end up producing an ill-typed witness of non-exhaustivity
+ corresponding to the current branch.
+
+ If [exhaust] has been called by [do_check_partial], then the witnesses
+ produced get typechecked and the ill-typed ones are discarded.
+
+ If [exhaust] has been called by [do_check_fragile], then it is possible
+ we might fail to warn the user that the matching is fragile. See for
+ example testsuite/tests/warnings/w04_failure.ml. *)
+ let q0 = discr_pat Patterns.Simple.omega pss in
+ match build_specialized_submatrices ~extend_row:(@) q0 pss with
+ | { default; constrs = [] } ->
+ (* first column of pss is made of variables only *)
+ let sub_witnesses = exhaust ext default (n-1) in
+ let q0 = Patterns.Head.to_omega_pattern q0 in
+ Seq.map (fun row -> q0::row) sub_witnesses
+ | { default; constrs } ->
+ let try_non_omega (p,pss) =
+ if is_absent_pat p then
+ Seq.empty
else
- let r = exhaust ext default (n-1) in
- match r with
- | No_matching_value -> before
- | Witnesses r ->
- try
- let p = build_other ext constrs in
- let dug = List.map (fun tail -> p :: tail) r in
- match before with
- | No_matching_value -> Witnesses dug
- | Witnesses x -> Witnesses (x @ dug)
- with
- (* cannot occur, since constructors don't make a full signature *)
- | Empty -> fatal_error "Parmatch.exhaust"
+ let sub_witnesses =
+ exhaust
+ ext pss
+ (List.length (simple_match_args p Patterns.Head.omega [])
+ + n - 1)
+ in
+ let p = Patterns.Head.to_omega_pattern p in
+ Seq.map (set_args p) sub_witnesses
+ in
+ let try_omega () =
+ if full_match false constrs && not (should_extend ext constrs) then
+ Seq.empty
+ else
+ let sub_witnesses = exhaust ext default (n-1) in
+ match build_other ext constrs with
+ | exception Empty ->
+ (* cannot occur, since constructors don't make
+ a full signature *)
+ fatal_error "Parmatch.exhaust"
+ | p ->
+ Seq.map (fun tail -> p :: tail) sub_witnesses
+ in
+ (* Lazily compute witnesses for all constructor submatrices
+ (Some constr_mat) then the wildcard/default submatrix (None).
+ Note that the call to [try_omega ()] is delayed to after
+ all constructor matrices have been traversed. *)
+ List.map (fun constr_mat -> Some constr_mat) constrs @ [None]
+ |> List.to_seq
+ |> Seq.flat_map
+ (function
+ | Some constr_mat -> try_non_omega constr_mat
+ | None -> try_omega ())
end
let exhaust ext pss n =
- let ret = exhaust ext pss n in
- match ret with
- No_matching_value -> No_matching_value
- | Witnesses lst ->
- let singletons =
- List.map
- (function
- [x] -> x
- | _ -> assert false)
- lst
- in
- Witnesses [orify_many singletons]
+ exhaust ext pss n
+ |> Seq.map (function
+ | [x] -> x
+ | _ -> assert false)
(*
Another exhaustiveness check, enforcing variant typing.
if not (all_coherent (first_column pss)) then
true
else begin
- let q0 = discr_pat omega pss in
+ let q0 = discr_pat Patterns.Simple.omega pss in
match build_specialized_submatrices ~extend_row:(@) q0 pss with
| { default; constrs = [] } -> pressure_variants tdefs default
| { default; constrs } ->
| [], _
| _, None -> ()
| (d, _) :: _, Some env ->
- match Pattern_head.desc d with
+ match d.pat_desc with
| Variant { type_row; _ } ->
let row = type_row () in
if Btype.row_fixed row
let make_rows pss = List.map make_row pss
-(* Useful to detect and expand or pats inside as pats *)
-let rec unalias p = match p.pat_desc with
-| Tpat_alias (p,_,_) -> unalias p
-| _ -> p
-
-
-let is_var p = match (unalias p).pat_desc with
-| Tpat_any|Tpat_var _ -> true
-| _ -> false
+(* Useful to detect and expand or pats inside as pats *)
+let is_var p = match Patterns.General.(view p |> strip_vars).pat_desc with
+| `Any -> true
+| _ -> false
let is_var_column rs =
List.for_all
Used
end
| q::rem ->
- let uq = unalias q in
- begin match uq.pat_desc with
- | Tpat_any | Tpat_var _ ->
+ begin match Patterns.General.(view q |> strip_vars).pat_desc with
+ | `Any ->
if is_var_column pss then
-(* forget about ``all-variable'' columns now *)
+ (* forget about ``all-variable'' columns now *)
every_satisfiables (remove_column pss) (remove qs)
else
-(* otherwise this is direct food for satisfiable *)
+ (* otherwise this is direct food for satisfiable *)
every_satisfiables (push_no_or_column pss) (push_no_or qs)
- | Tpat_or (q1,q2,_) ->
+ | `Or (q1,q2,_) ->
if
q1.pat_loc.Location.loc_ghost &&
q2.pat_loc.Location.loc_ghost
then
-(* syntactically generated or-pats should not be expanded *)
+ (* syntactically generated or-pats should not be expanded *)
every_satisfiables (push_no_or_column pss) (push_no_or qs)
else
-(* this is a real or-pattern *)
+ (* this is a real or-pattern *)
every_satisfiables (push_or_column pss) (push_or qs)
- | Tpat_variant (l,_,r) when is_absent l r -> (* Ah Jacques... *)
+ | `Variant (l,_,r) when is_absent l r -> (* Ah Jacques... *)
Unused
- | _ ->
-(* standard case, filter matrix *)
+ | #Patterns.Simple.view as view ->
+ let q = { q with pat_desc = view } in
+ (* standard case, filter matrix *)
let pss = simplify_first_usefulness_col pss in
- let huq, args = Pattern_head.deconstruct uq in
+ let hq, args = Patterns.Head.deconstruct q in
(* The handling of incoherent matrices is kept in line with
[satisfiable] *)
- if not (all_coherent (huq :: first_column pss)) then
+ if not (all_coherent (hq :: first_column pss)) then
Unused
else begin
let q0 = discr_pat q pss in
every_satisfiables
(build_specialized_submatrix q0 pss
~extend_row:(fun ps r -> { r with active = ps @ r.active }))
- {qs with active=simple_match_args q0 huq args @ rem}
+ {qs with active=simple_match_args q0 hq args @ rem}
end
end
let (ppat, constrs, labels) = Conv.conv (orify_many pats) in
PT_pattern (PE_gadt_cases, ppat, constrs, labels)
+let typecheck ~pred p =
+ let (pattern,constrs,labels) = Conv.conv p in
+ pred constrs labels pattern
+
let do_check_partial ~pred loc casel pss = match pss with
| [] ->
(*
end ;
Partial
| ps::_ ->
- begin match exhaust None pss (List.length ps) with
- | No_matching_value -> Total
- | Witnesses [u] ->
- let v =
- let (pattern,constrs,labels) = Conv.conv u in
- let u' = pred constrs labels pattern in
- (* pretty_pat u;
- begin match u' with
- None -> prerr_endline ": impossible"
- | Some _ -> prerr_endline ": possible"
- end; *)
- u'
+ let counter_examples =
+ exhaust None pss (List.length ps)
+ |> Seq.filter_map (typecheck ~pred) in
+ match counter_examples () with
+ | Seq.Nil -> Total
+ | Seq.Cons (v, _rest) ->
+ if Warnings.is_active (Warnings.Partial_match "") then begin
+ let errmsg =
+ try
+ let buf = Buffer.create 16 in
+ let fmt = Format.formatter_of_buffer buf in
+ Printpat.top_pretty fmt v;
+ if do_match (initial_only_guarded casel) [v] then
+ Buffer.add_string buf
+ "\n(However, some guarded clause may match this value.)";
+ if contains_extension v then
+ Buffer.add_string buf
+ "\nMatching over values of extensible variant types \
+ (the *extension* above)\n\
+ must include a wild card pattern in order to be exhaustive."
+ ;
+ Buffer.contents buf
+ with _ ->
+ ""
in
- begin match v with
- None -> Total
- | Some v ->
- if Warnings.is_active (Warnings.Partial_match "") then begin
- let errmsg =
- try
- let buf = Buffer.create 16 in
- let fmt = Format.formatter_of_buffer buf in
- Printpat.top_pretty fmt v;
- if do_match (initial_only_guarded casel) [v] then
- Buffer.add_string buf
- "\n(However, some guarded clause may match this value.)";
- if contains_extension v then
- Buffer.add_string buf
- "\nMatching over values of extensible variant types \
- (the *extension* above)\n\
- must include a wild card pattern in order to be exhaustive."
- ;
- Buffer.contents buf
- with _ ->
- ""
- in
- Location.prerr_warning loc (Warnings.Partial_match errmsg)
- end;
- Partial
- end
- | _ ->
- fatal_error "Parmatch.check_partial"
- end
+ Location.prerr_warning loc (Warnings.Partial_match errmsg)
+ end;
+ Partial
(*****************)
(* Fragile check *)
| ps::_ ->
List.iter
(fun ext ->
- match exhaust (Some ext) pss (List.length ps) with
- | No_matching_value ->
+ let witnesses = exhaust (Some ext) pss (List.length ps) in
+ match witnesses () with
+ | Seq.Nil ->
Location.prerr_warning
loc
(Warnings.Fragile_match (Path.name ext))
- | Witnesses _ -> ())
+ | Seq.Cons _ -> ())
exts
(********************************)
(********************************)
let check_unused pred casel =
- if Warnings.is_active Warnings.Unused_match
+ if Warnings.is_active Warnings.Redundant_case
|| List.exists (fun c -> c.c_rhs.exp_desc = Texp_unreachable) casel then
let rec do_rec pref = function
| [] -> ()
let qs = [q] in
begin try
let pss =
- get_mins le_pats (List.filter (compats qs) pref) in
+ (* prev was accumulated in reverse order;
+ restore source order to get ordered counter-examples *)
+ List.rev pref
+ |> List.filter (compats qs)
+ |> get_mins le_pats in
(* First look for redundant or partially redundant patterns *)
let r = every_satisfiables (make_rows pss) (make_row qs) in
let refute = (c_rhs.exp_desc = Texp_unreachable) in
match r with
| Unused ->
Location.prerr_warning
- q.pat_loc Warnings.Unused_match
+ q.pat_loc Warnings.Redundant_case
| Upartial ps ->
List.iter
(fun p ->
Location.prerr_warning
- p.pat_loc Warnings.Unused_pat)
+ p.pat_loc Warnings.Redundant_subpat)
ps
| Used -> ()
with Empty | Not_found -> assert false
let simplify_head_amb_pat head_bound_variables varsets ~add_column p ps k =
let rec simpl head_bound_variables varsets p ps k =
- match p.pat_desc with
- | Tpat_alias (p,x,_) ->
+ match (Patterns.General.view p).pat_desc with
+ | `Alias (p,x,_) ->
simpl (Ident.Set.add x head_bound_variables) varsets p ps k
- | Tpat_var (x,_) ->
- let rest_of_the_row =
- { row = ps; varsets = Ident.Set.add x head_bound_variables :: varsets; }
- in
- add_column (Pattern_head.deconstruct omega) rest_of_the_row k
- | Tpat_or (p1,p2,_) ->
+ | `Var (x, _) ->
+ simpl (Ident.Set.add x head_bound_variables) varsets Patterns.omega ps k
+ | `Or (p1,p2,_) ->
simpl head_bound_variables varsets p1 ps
(simpl head_bound_variables varsets p2 ps k)
- | _ ->
- add_column (Pattern_head.deconstruct p)
+ | #Patterns.Simple.view as view ->
+ add_column (Patterns.Head.deconstruct { p with pat_desc = view })
{ row = ps; varsets = head_bound_variables :: varsets; } k
in simpl head_bound_variables varsets p ps k
let extend_row columns = function
| Negative r -> Negative (columns @ r)
| Positive r -> Positive { r with row = columns @ r.row } in
- let q0 = discr_pat omega m in
+ let q0 = discr_pat Patterns.Simple.omega m in
let { default; constrs } =
build_specialized_submatrices ~extend_row q0 m in
let non_default = List.map snd constrs in
let check_ambiguous_bindings =
let open Warnings in
- let warn0 = Ambiguous_pattern [] in
+ let warn0 = Ambiguous_var_in_pattern_guard [] in
fun cases ->
if is_active warn0 then
let check_case ns case = match case with
if not (Ident.Set.is_empty ambiguous) then begin
let pps =
Ident.Set.elements ambiguous |> List.map Ident.name in
- let warn = Ambiguous_pattern pps in
+ let warn = Ambiguous_var_in_pattern_guard pps in
Location.prerr_warning p.pat_loc warn
end
end;
open Typedtree
open Types
-val omega : pattern
-(** aka. "Tpat_any" or "_" *)
-
-val omegas : int -> pattern list
-(** [List.init (fun _ -> omega)] *)
-
-val omega_list : 'a list -> pattern list
-(** [List.map (fun _ -> omega)] *)
-
-module Pattern_head : sig
- type desc =
- | Any
- | Construct of constructor_description
- | Constant of constant
- | Tuple of int
- | Record of label_description list
- | Variant of
- { tag: label; has_arg: bool;
- cstr_row: row_desc ref;
- type_row : unit -> row_desc; }
- (* the row of the type may evolve if [close_variant] is called,
- hence the (unit -> ...) delay *)
- | Array of int
- | Lazy
-
- type t
-
- val desc : t -> desc
- val env : t -> Env.t
- val loc : t -> Location.t
- val typ : t -> Types.type_expr
-
- (** [deconstruct p] returns the head of [p] and the list of sub patterns.
-
- @raises [Invalid_arg _] if [p] is an or- or an exception-pattern. *)
- val deconstruct : pattern -> t * pattern list
-
- (** reconstructs a pattern, putting wildcards as sub-patterns. *)
- val to_omega_pattern : t -> pattern
-
- val make
- : loc:Location.t
- -> typ:Types.type_expr
- -> env:Env.t
- -> desc
- -> t
-
- val omega : t
-
-end
-
-val normalize_pat : pattern -> pattern
-(** Keep only the "head" of a pattern: all arguments are replaced by [omega], so
- are variables. *)
-
val const_compare : constant -> constant -> int
(** [const_compare c1 c2] compares the actual values represented by [c1] and
[c2], while simply using [Stdlib.compare] would compare the
val pat_of_constr : pattern -> constructor_description -> pattern
val complete_constrs :
- pattern -> constructor_tag list -> constructor_description list
+ constructor_description pattern_data ->
+ constructor_tag list ->
+ constructor_description list
(** [ppat_of_type] builds an untyped pattern from its expected type,
for explosion of wildcard patterns in Typecore.type_pat.
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Gabriel Scherer, projet Partout, INRIA Paris-Saclay *)
+(* Thomas Refis, Jane Street Europe *)
+(* *)
+(* Copyright 2019 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+open Asttypes
+open Types
+open Typedtree
+
+(* useful pattern auxiliary functions *)
+
+let omega = {
+ pat_desc = Tpat_any;
+ pat_loc = Location.none;
+ pat_extra = [];
+ pat_type = Ctype.none;
+ pat_env = Env.empty;
+ pat_attributes = [];
+}
+
+let rec omegas i =
+ if i <= 0 then [] else omega :: omegas (i-1)
+
+let omega_list l = List.map (fun _ -> omega) l
+
+module Non_empty_row = struct
+ type 'a t = 'a * Typedtree.pattern list
+
+ let of_initial = function
+ | [] -> assert false
+ | pat :: patl -> (pat, patl)
+
+ let map_first f (p, patl) = (f p, patl)
+end
+
+(* "views" on patterns are polymorphic variants
+ that allow to restrict the set of pattern constructors
+ statically allowed at a particular place *)
+
+module Simple = struct
+ type view = [
+ | `Any
+ | `Constant of constant
+ | `Tuple of pattern list
+ | `Construct of
+ Longident.t loc * constructor_description * pattern list
+ | `Variant of label * pattern option * row_desc ref
+ | `Record of
+ (Longident.t loc * label_description * pattern) list * closed_flag
+ | `Array of pattern list
+ | `Lazy of pattern
+ ]
+
+ type pattern = view pattern_data
+
+ let omega = { omega with pat_desc = `Any }
+end
+
+module Half_simple = struct
+ type view = [
+ | Simple.view
+ | `Or of pattern * pattern * row_desc option
+ ]
+
+ type pattern = view pattern_data
+end
+
+module General = struct
+ type view = [
+ | Half_simple.view
+ | `Var of Ident.t * string loc
+ | `Alias of pattern * Ident.t * string loc
+ ]
+ type pattern = view pattern_data
+
+ let view_desc = function
+ | Tpat_any ->
+ `Any
+ | Tpat_var (id, str) ->
+ `Var (id, str)
+ | Tpat_alias (p, id, str) ->
+ `Alias (p, id, str)
+ | Tpat_constant cst ->
+ `Constant cst
+ | Tpat_tuple ps ->
+ `Tuple ps
+ | Tpat_construct (cstr, cstr_descr, args) ->
+ `Construct (cstr, cstr_descr, args)
+ | Tpat_variant (cstr, arg, row_desc) ->
+ `Variant (cstr, arg, row_desc)
+ | Tpat_record (fields, closed) ->
+ `Record (fields, closed)
+ | Tpat_array ps -> `Array ps
+ | Tpat_or (p, q, row_desc) -> `Or (p, q, row_desc)
+ | Tpat_lazy p -> `Lazy p
+
+ let view p : pattern =
+ { p with pat_desc = view_desc p.pat_desc }
+
+ let erase_desc = function
+ | `Any -> Tpat_any
+ | `Var (id, str) -> Tpat_var (id, str)
+ | `Alias (p, id, str) -> Tpat_alias (p, id, str)
+ | `Constant cst -> Tpat_constant cst
+ | `Tuple ps -> Tpat_tuple ps
+ | `Construct (cstr, cst_descr, args) ->
+ Tpat_construct (cstr, cst_descr, args)
+ | `Variant (cstr, arg, row_desc) ->
+ Tpat_variant (cstr, arg, row_desc)
+ | `Record (fields, closed) ->
+ Tpat_record (fields, closed)
+ | `Array ps -> Tpat_array ps
+ | `Or (p, q, row_desc) -> Tpat_or (p, q, row_desc)
+ | `Lazy p -> Tpat_lazy p
+
+ let erase p : Typedtree.pattern =
+ { p with pat_desc = erase_desc p.pat_desc }
+
+ let rec strip_vars (p : pattern) : Half_simple.pattern =
+ match p.pat_desc with
+ | `Alias (p, _, _) -> strip_vars (view p)
+ | `Var _ -> { p with pat_desc = `Any }
+ | #Half_simple.view as view -> { p with pat_desc = view }
+end
+
+(* the head constructor of a simple pattern *)
+
+module Head : sig
+ type desc =
+ | Any
+ | Construct of constructor_description
+ | Constant of constant
+ | Tuple of int
+ | Record of label_description list
+ | Variant of
+ { tag: label; has_arg: bool;
+ cstr_row: row_desc ref;
+ type_row : unit -> row_desc; }
+ | Array of int
+ | Lazy
+
+ type t = desc pattern_data
+
+ val arity : t -> int
+
+ (** [deconstruct p] returns the head of [p] and the list of sub patterns. *)
+ val deconstruct : Simple.pattern -> t * pattern list
+
+ (** reconstructs a pattern, putting wildcards as sub-patterns. *)
+ val to_omega_pattern : t -> pattern
+
+ val omega : t
+end = struct
+ type desc =
+ | Any
+ | Construct of constructor_description
+ | Constant of constant
+ | Tuple of int
+ | Record of label_description list
+ | Variant of
+ { tag: label; has_arg: bool;
+ cstr_row: row_desc ref;
+ type_row : unit -> row_desc; }
+ (* the row of the type may evolve if [close_variant] is called,
+ hence the (unit -> ...) delay *)
+ | Array of int
+ | Lazy
+
+ type t = desc pattern_data
+
+ let deconstruct (q : Simple.pattern) =
+ let deconstruct_desc = function
+ | `Any -> Any, []
+ | `Constant c -> Constant c, []
+ | `Tuple args ->
+ Tuple (List.length args), args
+ | `Construct (_, c, args) ->
+ Construct c, args
+ | `Variant (tag, arg, cstr_row) ->
+ let has_arg, pats =
+ match arg with
+ | None -> false, []
+ | Some a -> true, [a]
+ in
+ let type_row () =
+ match Ctype.expand_head q.pat_env q.pat_type with
+ | {desc = Tvariant type_row} -> Btype.row_repr type_row
+ | _ -> assert false
+ in
+ Variant {tag; has_arg; cstr_row; type_row}, pats
+ | `Array args ->
+ Array (List.length args), args
+ | `Record (largs, _) ->
+ let lbls = List.map (fun (_,lbl,_) -> lbl) largs in
+ let pats = List.map (fun (_,_,pat) -> pat) largs in
+ Record lbls, pats
+ | `Lazy p ->
+ Lazy, [p]
+ in
+ let desc, pats = deconstruct_desc q.pat_desc in
+ { q with pat_desc = desc }, pats
+
+ let arity t =
+ match t.pat_desc with
+ | Any -> 0
+ | Constant _ -> 0
+ | Construct c -> c.cstr_arity
+ | Tuple n | Array n -> n
+ | Record l -> List.length l
+ | Variant { has_arg; _ } -> if has_arg then 1 else 0
+ | Lazy -> 1
+
+ let to_omega_pattern t =
+ let pat_desc =
+ let mkloc x = Location.mkloc x t.pat_loc in
+ match t.pat_desc with
+ | Any -> Tpat_any
+ | Lazy -> Tpat_lazy omega
+ | Constant c -> Tpat_constant c
+ | Tuple n -> Tpat_tuple (omegas n)
+ | Array n -> Tpat_array (omegas n)
+ | Construct c ->
+ let lid_loc = mkloc (Longident.Lident c.cstr_name) in
+ Tpat_construct (lid_loc, c, omegas c.cstr_arity)
+ | Variant { tag; has_arg; cstr_row } ->
+ let arg_opt = if has_arg then Some omega else None in
+ Tpat_variant (tag, arg_opt, cstr_row)
+ | Record lbls ->
+ let lst =
+ List.map (fun lbl ->
+ let lid_loc = mkloc (Longident.Lident lbl.lbl_name) in
+ (lid_loc, lbl, omega)
+ ) lbls
+ in
+ Tpat_record (lst, Closed)
+ in
+ { t with
+ pat_desc;
+ pat_extra = [];
+ }
+
+ let omega = { omega with pat_desc = Any }
+end
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Gabriel Scherer, projet Partout, INRIA Paris-Saclay *)
+(* Thomas Refis, Jane Street Europe *)
+(* *)
+(* Copyright 2019 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+open Asttypes
+open Typedtree
+open Types
+
+val omega : pattern
+(** aka. "Tpat_any" or "_" *)
+
+val omegas : int -> pattern list
+(** [List.init (fun _ -> omega)] *)
+
+val omega_list : 'a list -> pattern list
+(** [List.map (fun _ -> omega)] *)
+
+module Non_empty_row : sig
+ type 'a t = 'a * Typedtree.pattern list
+
+ val of_initial : Typedtree.pattern list -> Typedtree.pattern t
+ (** 'assert false' on empty rows *)
+
+ val map_first : ('a -> 'b) -> 'a t -> 'b t
+end
+
+module Simple : sig
+ type view = [
+ | `Any
+ | `Constant of constant
+ | `Tuple of pattern list
+ | `Construct of
+ Longident.t loc * constructor_description * pattern list
+ | `Variant of label * pattern option * row_desc ref
+ | `Record of
+ (Longident.t loc * label_description * pattern) list * closed_flag
+ | `Array of pattern list
+ | `Lazy of pattern
+ ]
+ type pattern = view pattern_data
+
+ val omega : [> view ] pattern_data
+end
+
+module Half_simple : sig
+ type view = [
+ | Simple.view
+ | `Or of pattern * pattern * row_desc option
+ ]
+ type pattern = view pattern_data
+end
+
+module General : sig
+ type view = [
+ | Half_simple.view
+ | `Var of Ident.t * string loc
+ | `Alias of pattern * Ident.t * string loc
+ ]
+ type pattern = view pattern_data
+
+ val view : Typedtree.pattern -> pattern
+ val erase : [< view ] pattern_data -> Typedtree.pattern
+
+ val strip_vars : pattern -> Half_simple.pattern
+end
+
+module Head : sig
+ type desc =
+ | Any
+ | Construct of constructor_description
+ | Constant of constant
+ | Tuple of int
+ | Record of label_description list
+ | Variant of
+ { tag: label; has_arg: bool;
+ cstr_row: row_desc ref;
+ type_row : unit -> row_desc; }
+ (* the row of the type may evolve if [close_variant] is called,
+ hence the (unit -> ...) delay *)
+ | Array of int
+ | Lazy
+
+ type t = desc pattern_data
+
+ val arity : t -> int
+
+ (** [deconstruct p] returns the head of [p] and the list of sub patterns.
+
+ @raise [Invalid_arg _] if [p] is an or- or an exception-pattern. *)
+ val deconstruct : Simple.pattern -> t * pattern list
+
+ (** reconstructs a pattern, putting wildcards as sub-patterns. *)
+ val to_omega_pattern : t -> pattern
+
+ val omega : t
+
+end
let ty = safe_repr [] ty in
if List.memq ty !visited then fprintf ppf "{id=%d}" ty.id else begin
visited := ty :: !visited;
- fprintf ppf "@[<1>{id=%d;level=%d;desc=@,%a}@]" ty.id ty.level
- raw_type_desc ty.desc
+ fprintf ppf "@[<1>{id=%d;level=%d;scope=%d;desc=@,%a}@]" ty.id ty.level
+ ty.scope raw_type_desc ty.desc
end
and raw_type_list tl = raw_list raw_type tl
and raw_type_desc ppf = function
type best_path = Paths of Path.t list | Best of Path.t
-let printing_depth = ref 0
-let printing_cont = ref ([] : Env.iter_cont list)
+(** Short-paths cache: the five mutable variables below implement a one-slot
+ cache for short-paths
+ *)
let printing_old = ref Env.empty
let printing_pers = ref Concr.empty
+(** {!printing_old} and {!printing_pers} are the keys of the one-slot cache *)
+
+let printing_depth = ref 0
+let printing_cont = ref ([] : Env.iter_cont list)
let printing_map = ref Path.Map.empty
+(**
+ - {!printing_map} is the main value stored in the cache.
+ Note that it is evaluated lazily and its value is updated during printing.
+ - {!printing_dep} is the current exploration depth of the environment,
+ it is used to determine whenever the {!printing_map} should be evaluated
+ further before completing a request.
+ - {!printing_cont} is the list of continuations needed to evaluate
+ the {!printing_map} one level further (see also {!Env.run_iter_cont})
+*)
let same_type t t' = repr t == repr t'
| Tunivar _ -> add_named_var ty
let mark_loops ty =
- normalize_type Env.empty ty;
+ normalize_type ty;
mark_loops_rec [] ty;;
let reset_loop_marks () =
let vari =
List.map2
(fun ty v ->
- if abstr || not (is_Tvar (repr ty)) then Variance.get_upper v
- else (true,true))
+ let is_var = is_Tvar (repr ty) in
+ if abstr || not is_var then
+ let inj =
+ decl.type_kind = Type_abstract && Variance.mem Inj v &&
+ match decl.type_manifest with
+ | None -> true
+ | Some ty -> (* only abstract or private row types *)
+ decl.type_private = Private &&
+ Btype.is_constr_row ~allow_ident:true (Btype.row_of_type ty)
+ and (co, cn) = Variance.get_upper v in
+ (if not cn then Covariant else
+ if not co then Contravariant else NoVariance),
+ (if inj then Injective else NoInjectivity)
+ else (NoVariance, NoInjectivity))
decl.type_params decl.type_variance
in
(Ident.name id,
(match tree_of_typexp true param with
Otyp_var (_, s) -> s
| _ -> "?"),
- if is_Tvar (repr param) then (true, true) else variance
+ if is_Tvar (repr param) then Asttypes.(NoVariance, NoInjectivity)
+ else variance
let class_variance =
- List.map Variance.(fun v -> mem May_pos v, mem May_neg v)
+ let open Variance in let open Asttypes in
+ List.map (fun v ->
+ (if not (mem May_pos v) then Contravariant else
+ if not (mem May_neg v) then Covariant else NoVariance),
+ NoInjectivity)
let tree_of_class_declaration id cl rs =
let params = filter_params cl.cty_params in
(* Print a module type *)
let wrap_env fenv ftree arg =
+ (* We save the current value of the short-path cache *)
+ (* From keys *)
let env = !printing_env in
+ let old_pers = !printing_pers in
+ (* to data *)
+ let old_map = !printing_map in
+ let old_depth = !printing_depth in
+ let old_cont = !printing_cont in
set_printing_env (fenv env);
let tree = ftree arg in
+ if !Clflags.real_paths
+ || same_printing_env env then ()
+ (* our cached key is still live in the cache, and we want to keep all
+ progress made on the computation of the [printing_map] *)
+ else begin
+ (* we restore the snapshotted cache before calling set_printing_env *)
+ printing_old := env;
+ printing_pers := old_pers;
+ printing_depth := old_depth;
+ printing_cont := old_cont;
+ printing_map := old_map
+ end;
set_printing_env env;
tree
| Trace.Obj o -> explain_object o
| Trace.Rec_occur(x,y) ->
reset_and_mark_loops y;
- Some(dprintf "@,@[<hov>The type variable %a occurs inside@ %a@]"
- marked_type_expr x marked_type_expr y)
+ begin match x.desc with
+ | Tvar _ | Tunivar _ ->
+ Some(dprintf "@,@[<hov>The type variable %a occurs inside@ %a@]"
+ marked_type_expr x marked_type_expr y)
+ | _ ->
+ (* We had a delayed unification of the type variable with
+ a non-variable after the occur check. *)
+ Some ignore
+ (* There is no need to search further for an explanation, but
+ we don't want to print a message of the form:
+ {[ The type int occurs inside int list -> 'a |}
+ *)
+ end
let mismatch intro env trace =
Trace.explain trace (fun ~prev h -> explanation intro prev env h)
open Types
open Btype
+open Local_store
+
type type_replacement =
| Path of Path.t
| Type_function of { params : type_expr list; body : type_expr }
(* Special type ids for saved signatures *)
-let new_id = ref (-1)
+let new_id = s_ref (-1)
let reset_for_saving () = new_id := -1
let newpersty desc =
end
pv
in
- let not_function = function
- Cty_arrow _ -> false
+ let rec not_nolabel_function = function
+ | Cty_arrow(Nolabel, _, _) -> false
+ | Cty_arrow(_, _, cty) -> not_nolabel_function cty
| _ -> true
in
let partial =
Ctype.raise_nongen_level ();
let cl = class_expr cl_num val_env' met_env scl' in
Ctype.end_def ();
- if Btype.is_optional l && not_function cl.cl_type then
+ if Btype.is_optional l && not_nolabel_function cl.cl_type then
Location.prerr_warning pat.pat_loc
Warnings.Unerasable_optional_argument;
rc {cl_desc = Tcl_fun (l, pat, pv, cl, partial);
}
| Pcl_let (rec_flag, sdefs, scl') ->
let (defs, val_env) =
- Typecore.type_let In_class_def val_env rec_flag sdefs None in
+ Typecore.type_let In_class_def val_env rec_flag sdefs in
let (vals, met_env) =
List.fold_right
(fun (id, _id_loc, _typ) (vals, met_env) ->
type_kind = Type_abstract;
type_private = Public;
type_manifest = Some ty;
- type_variance = Misc.replicate_list Variance.full arity;
+ type_variance = Variance.unknown_signature ~injective:false ~arity;
type_separability = Types.Separability.default_signature ~arity;
type_is_newtype = false;
type_expansion_scope = Btype.lowest_level;
end;
(* Class and class type temporary definitions *)
- let cty_variance = List.map (fun _ -> Variance.full) params in
+ let cty_variance =
+ Variance.unknown_signature ~injective:false ~arity:(List.length params) in
let cltydef =
{clty_params = params; clty_type = class_body typ;
clty_variance = cty_variance;
type_kind = Type_abstract;
type_private = Public;
type_manifest = Some obj_ty;
- type_variance = List.map (fun _ -> Variance.full) obj_params;
+ type_variance = Variance.unknown_signature ~injective:false ~arity;
type_separability = Types.Separability.default_signature ~arity;
type_is_newtype = false;
type_expansion_scope = Btype.lowest_level;
type_kind = Type_abstract;
type_private = Public;
type_manifest = Some cl_ty;
- type_variance = List.map (fun _ -> Variance.full) cl_params;
+ type_variance = Variance.unknown_signature ~injective:false ~arity;
type_separability = Types.Separability.default_signature ~arity;
type_is_newtype = false;
type_expansion_scope = Btype.lowest_level;
Some y -> y
| None -> assert false
+let nothing_equated = TypePairs.create 0
+
(* unification inside type_pat*)
-let unify_pat_types ?(refine=false) loc env ty ty' =
+let unify_pat_types_return_equated_pairs ?(refine = None) loc env ty ty' =
try
- if refine then
- unify_gadt ~equations_level:(get_gadt_equations_level ()) env ty ty'
- else
- unify !env ty ty'
+ match refine with
+ | Some allow_recursive ->
+ unify_gadt ~equations_level:(get_gadt_equations_level ())
+ ~allow_recursive env ty ty'
+ | None ->
+ unify !env ty ty';
+ nothing_equated
with
| Unify trace ->
raise(Error(loc, !env, Pattern_type_clash(trace, None)))
| Tags(l1,l2) ->
raise(Typetexp.Error(loc, !env, Typetexp.Variant_tags (l1, l2)))
+let unify_pat_types ?refine loc env ty ty' =
+ ignore (unify_pat_types_return_equated_pairs ?refine loc env ty ty')
+
let unify_pat ?refine env pat expected_ty =
try unify_pat_types ?refine pat.pat_loc env pat.pat_type expected_ty
with Error (loc, env, Pattern_type_clash(trace, None)) ->
let pattern_variables = ref ([] : pattern_variable list)
let pattern_force = ref ([] : (unit -> unit) list)
-let pattern_scope = ref (None : Annot.ident option);;
let allow_modules = ref false
let module_variables = ref ([] : module_variable list)
-let reset_pattern scope allow =
+let reset_pattern allow =
pattern_variables := [];
pattern_force := [];
- pattern_scope := scope;
allow_modules := allow;
module_variables := [];
;;
unify_vars p1_vs p2_vs
let rec build_as_type env p =
+ let as_ty = build_as_type_aux env p in
+ (* Cf. #1655 *)
+ List.fold_left (fun as_ty (extra, _loc, _attrs) ->
+ match extra with
+ | Tpat_type _ | Tpat_open _ | Tpat_unpack -> as_ty
+ | Tpat_constraint cty ->
+ begin_def ();
+ let ty = instance cty.ctyp_type in
+ 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);
+ ty
+ ) as_ty p.pat_extra
+
+and build_as_type_aux env p =
match p.pat_desc with
Tpat_alias(p1,_, _) -> build_as_type env p1
| Tpat_tuple pl ->
else defined.(label.lbl_pos) <- true in
List.iter check_defined lbl_pat_list;
if closed = Closed
- && Warnings.is_active (Warnings.Non_closed_record_pattern "")
+ && Warnings.is_active (Warnings.Missing_record_field_pattern "")
then begin
let undefined = ref [] in
for i = 0 to Array.length all - 1 do
done;
if !undefined <> [] then begin
let u = String.concat ", " (List.rev !undefined) in
- Location.prerr_warning loc (Warnings.Non_closed_record_pattern u)
+ Location.prerr_warning loc (Warnings.Missing_record_field_pattern u)
end
end
type_pat category ~no_existentials ~mode ~env
in
let loc = sp.ppat_loc in
- let refine = match mode with Normal -> false | Counter_example _ -> true in
+ let refine =
+ match mode with Normal -> None | Counter_example _ -> Some true in
let unif (x : pattern) : pattern =
unify_pat ~refine env x (instance expected_ty);
x
({ptyp_desc=Ptyp_poly _} as sty)) ->
(* explicitly polymorphic type *)
assert construction_not_used_in_counterexamples;
- let cty, force = Typetexp.transl_simple_type_delayed !env sty in
- let ty = cty.ctyp_type in
+ let cty, ty, force = Typetexp.transl_simple_type_delayed !env sty in
unify_pat_types ~refine lloc env ty (instance expected_ty);
pattern_force := force :: !pattern_force;
begin match ty.desc with
| Tpoly (body, tyl) ->
begin_def ();
+ init_def generic_level;
let _, ty' = instance_poly ~keep_names:true false tyl body in
end_def ();
- generalize ty';
let id = enter_variable lloc name ty' attrs in
rvp k {
pat_desc = Tpat_var (id, name);
assert (List.length spl >= 2);
let spl_ann = List.map (fun p -> (p,newgenvar ())) spl in
let ty = newgenty (Ttuple(List.map snd spl_ann)) in
- begin_def ();
- let expected_ty = instance expected_ty in
- end_def ();
- generalize_structure expected_ty;
+ let expected_ty = generic_instance expected_ty in
unify_pat_types ~refine loc env ty expected_ty;
map_fold_cont (fun (p,t) -> type_pat Value p t) spl_ann (fun pl ->
rvp k {
let expected_type =
try
let (p0, p, _) = extract_concrete_variant !env expected_ty in
- Some (p0, p, true)
+ let principal =
+ (repr expected_ty).level = generic_level || not !Clflags.principal
+ in
+ Some (p0, p, principal)
with Not_found -> None
in
let constr =
in
let expected_ty = instance expected_ty in
(* PR#7214: do not use gadt unification for toplevel lets *)
- unify_pat_types loc env ty_res expected_ty
- ~refine:(refine || constr.cstr_generalized && no_existentials = None);
+ let refine =
+ if refine = None && constr.cstr_generalized && no_existentials = None
+ then Some false
+ else refine
+ in
+ let equated_types =
+ unify_pat_types_return_equated_pairs ~refine loc env ty_res expected_ty
+ in
end_def ();
generalize_structure expected_ty;
generalize_structure ty_res;
List.iter generalize_structure ty_args;
+ if !Clflags.principal then (
+ let exception Warn_only_once in
+ try
+ TypePairs.iter (fun (t1, t2) () ->
+ generalize_structure t1;
+ generalize_structure t2;
+ if not (fully_generic t1 && fully_generic t2) then
+ let msg =
+ Format.asprintf
+ "typing this pattern requires considering@ %a@ and@ %a@ as \
+ equal.@,\
+ But the knowledge of these types"
+ Printtyp.type_expr t1
+ Printtyp.type_expr t2
+ in
+ Location.prerr_warning loc (Warnings.Not_principal msg);
+ raise Warn_only_once
+ ) equated_types
+ with Warn_only_once -> ()
+ );
let rec check_non_escaping p =
match p.ppat_desc with
row_more = newgenvar ();
row_fixed = None;
row_name = None } in
- begin_def ();
- let expected_ty = instance expected_ty in
- end_def ();
- generalize_structure expected_ty;
+ 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 l = Parmatch.some_private_tag
let expected_type, record_ty =
try
let (p0, p,_) = extract_concrete_record !env expected_ty in
- begin_def ();
- let ty = instance expected_ty in
- end_def ();
- generalize_structure ty;
- Some (p0, p, true), ty
+ 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 ()
in
let type_label_pat (label_lid, label, sarg) k =
end
| Ppat_array spl ->
let ty_elt = newgenvar() in
- begin_def ();
- let expected_ty = instance expected_ty in
- end_def ();
- generalize_structure expected_ty;
+ let expected_ty = generic_instance expected_ty in
unify_pat_types ~refine
loc env (Predef.type_array ty_elt) expected_ty;
map_fold_cont (fun p -> type_pat Value p ty_elt) spl (fun pl ->
end
| Ppat_lazy sp1 ->
let nv = newgenvar () in
- unify_pat_types ~refine loc env (Predef.type_lazy_t nv) expected_ty;
+ unify_pat_types ~refine loc env (Predef.type_lazy_t nv)
+ (generic_instance expected_ty);
(* do not explode under lazy: PR#7421 *)
type_pat Value ~mode:(no_explosion mode) sp1 nv (fun p1 ->
rvp k {
| Ppat_constraint(sp, sty) ->
(* Pretend separate = true *)
begin_def();
- let cty, force = Typetexp.transl_simple_type_delayed !env sty in
- let ty = cty.ctyp_type in
+ let cty, ty, force = Typetexp.transl_simple_type_delayed !env sty in
end_def();
generalize_structure ty;
let ty, expected_ty' = instance ty, ty in
let type_pat category ?no_existentials ?(mode=Normal)
?(lev=get_current_level()) env sp expected_ty =
Misc.protect_refs [Misc.R (gadt_equations_level, Some lev)] (fun () ->
- let r =
type_pat category ~no_existentials ~mode
~env sp expected_ty (fun x -> x)
- in
- map_general_pattern { f = fun p -> { p with pat_env = !env } } r
)
(* this function is passed to Partial.parmatch
constrs; labels;
} in
try
- reset_pattern None true;
+ reset_pattern true;
let typed_p = type_pat Value ~lev ~mode env p expected_ty in
set_state state env;
(* types are invalidated but we don't need them here *)
)
pv env
-let type_pattern category ~lev env spat scope expected_ty =
- reset_pattern scope true;
+let type_pattern category ~lev env spat expected_ty =
+ reset_pattern true;
let new_env = ref env in
let pat = type_pat category ~lev new_env spat expected_ty in
let pvs = get_ref pattern_variables in
(pat, !new_env, get_ref pattern_force, pvs, unpacks)
let type_pattern_list
- category no_existentials env spatl scope expected_tys allow
+ category no_existentials env spatl expected_tys allow
=
- reset_pattern scope allow;
+ reset_pattern allow;
let new_env = ref env in
let type_pat (attrs, pat) ty =
Builtin_attributes.warning_scope ~ppwarning:false attrs
(patl, new_env, get_ref pattern_force, pvs, unpacks)
let type_class_arg_pattern cl_num val_env met_env l spat =
- reset_pattern None false;
+ reset_pattern false;
let nv = newvar () in
let pat =
type_pat Value ~no_existentials:In_class_args (ref val_env) spat nv in
Pat.mk (Ppat_alias (Pat.mk(Ppat_alias (spat, mknoloc "selfpat-*")),
mknoloc ("selfpat-" ^ cl_num)))
in
- reset_pattern None false;
+ reset_pattern false;
let nv = newvar() in
let pat =
type_pat Value ~no_existentials:In_self_pattern (ref val_env) spat nv in
| Some (_, loc, _) -> loc
| None -> exp_loc
in
- Location.prerr_warning loc Warnings.Statement_type
+ Location.prerr_warning loc Warnings.Non_unit_statement
in
loop exp
in
| Texp_letexception (_, e) | Texp_letmodule (_, _, _, _, e) ->
check e
| Texp_apply _ | Texp_send _ | Texp_new _ | Texp_letop _ ->
- Location.prerr_warning exp_loc Warnings.Partial_application
+ Location.prerr_warning exp_loc
+ Warnings.Ignored_partial_application
end
in
check exp
if rec_flag = Recursive then In_rec
else if List.compare_length_with spat_sexp_list 1 > 0 then In_group
else With_attributes in
- let scp =
- match sexp.pexp_attributes, rec_flag with
- | [{attr_name = {txt="#default"}; _}], _ -> None
- | _, Recursive -> Some (Annot.Idef loc)
- | _, Nonrecursive -> Some (Annot.Idef sbody.pexp_loc)
- in
let (pat_exp_list, new_env, unpacks) =
- type_let existential_context env rec_flag spat_sexp_list scp true in
+ type_let existential_context env rec_flag spat_sexp_list true in
let body = type_unpacks new_env unpacks sbody ty_expected_explained in
let () =
if rec_flag = Recursive then
let (args, ty_res) = type_application env funct sargs in
end_def ();
unify_var env (newvar()) funct.exp_type;
- rue {
- exp_desc = Texp_apply(funct, args);
- exp_loc = loc; exp_extra = [];
- exp_type = ty_res;
- exp_attributes = sexp.pexp_attributes;
- exp_env = env }
+ let exp =
+ { exp_desc = Texp_apply(funct, args);
+ exp_loc = loc; exp_extra = [];
+ exp_type = ty_res;
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env } in
+ begin
+ try rue exp
+ with Error (_, _, Expr_type_clash _) as err ->
+ Misc.reraise_preserving_backtrace err (fun () ->
+ check_partial_application false exp)
+ end
| Pexp_match(sarg, caselist) ->
begin_def ();
let arg = type_exp env sarg in
if maybe_expansive arg then lower_contravariant env arg.exp_type;
generalize arg.exp_type;
let cases, partial =
- type_cases Computation env arg.exp_type ty_expected true loc caselist in
+ type_cases Computation env
+ arg.exp_type ty_expected_explained true loc caselist in
re {
exp_desc = Texp_match(arg, cases, partial);
exp_loc = loc; exp_extra = [];
| Pexp_try(sbody, caselist) ->
let body = type_expect env sbody ty_expected_explained in
let cases, _ =
- type_cases Value env Predef.type_exn ty_expected false loc caselist in
+ type_cases Value env
+ Predef.type_exn ty_expected_explained false loc caselist in
re {
exp_desc = Texp_try(body, cases);
exp_loc = loc; exp_extra = [];
let subtypes = List.map (fun _ -> newgenvar ()) sexpl in
let to_unify = newgenty (Ttuple subtypes) in
with_explanation (fun () ->
- unify_exp_types loc env to_unify ty_expected);
+ unify_exp_types loc env to_unify (generic_instance ty_expected));
let expl =
List.map2 (fun body ty -> type_expect env body (mk_expected ty))
sexpl subtypes
Some (p0, p, principal)
with Not_found -> None
in
- match get_path ty_expected with
- None ->
+ 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 -> newvar (), None
+ None -> ty, opath
| Some exp ->
match get_path exp.exp_type with
- None -> newvar (), None
- | Some (_, p', _) as op ->
+ 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, op
+ ty, opath
end
- | op -> ty_expected, op
+ | _ -> ty_expected, opath
in
let closed = (opt_sexp = None) in
let lbl_exp_list =
(fun x -> x)
in
with_explanation (fun () ->
- unify_exp_types loc env ty_record (instance ty_expected));
+ unify_exp_types loc env (instance ty_record) (instance ty_expected));
(* type_label_a_list returns a list of labels sorted by lbl_pos *)
(* note: check_duplicates would better be implemented in
let ty = newgenvar() in
let to_unify = Predef.type_array ty in
with_explanation (fun () ->
- unify_exp_types loc env to_unify ty_expected);
+ unify_exp_types loc env to_unify (generic_instance ty_expected));
let argl =
List.map (fun sarg -> type_expect env sarg (mk_expected ty)) sargl in
re {
let (arg, ty',cty,cty') =
match sty with
| None ->
- let (cty', force) =
+ let (cty', ty', force) =
Typetexp.transl_simple_type_delayed env sty'
in
- let ty' = cty'.ctyp_type in
begin_def ();
let arg = type_exp env sarg in
end_def ();
(arg, ty', None, cty')
| Some sty ->
begin_def ();
- let (cty, force) =
+ let (cty, ty, force) =
Typetexp.transl_simple_type_delayed env sty
- and (cty', force') =
+ and (cty', ty', force') =
Typetexp.transl_simple_type_delayed env sty'
in
- let ty = cty.ctyp_type in
- let ty' = cty'.ctyp_type in
begin try
let force'' = subtype env ty ty' in
force (); force' (); force'' ()
let ty = newgenvar () in
let to_unify = Predef.type_lazy_t ty in
with_explanation (fun () ->
- unify_exp_types loc env to_unify ty_expected);
+ unify_exp_types loc env to_unify (generic_instance ty_expected));
let arg = type_expect env e (mk_expected ty) in
re {
exp_desc = Texp_lazy arg;
exp_attributes = sexp.pexp_attributes;
exp_env = env }
| Pexp_open (od, e) ->
+ let tv = newvar () in
let (od, _, newenv) = !type_open_decl env od in
let exp = type_expect newenv e ty_expected_explained in
- rue {
+ (* Force the return type to be well-formed in the original
+ environment. *)
+ unify_var newenv tv exp.exp_type;
+ re {
exp_desc = Texp_open (od, exp);
exp_type = exp.exp_type;
exp_loc = loc;
let exp, ands = type_andops env slet.pbop_exp sands ty_andops in
let scase = Ast_helper.Exp.case spat_params sbody in
let cases, partial =
- type_cases Value env ty_params ty_func_result true loc [scase]
+ type_cases Value env
+ ty_params (mk_expected ty_func_result) true loc [scase]
in
let body =
match cases with
generalize_structure ty_res
end;
let cases, partial =
- type_cases Value ~in_function:(loc_fun,ty_fun) env ty_arg ty_res
- true loc caselist in
- let not_function ty =
+ type_cases Value ~in_function:(loc_fun,ty_fun) env
+ ty_arg (mk_expected ty_res) true loc caselist in
+ let not_nolabel_function ty =
let ls, tvar = list_labels env ty in
- ls = [] && not tvar
+ List.for_all ((<>) Nolabel) ls && not tvar
in
- if is_optional l && not_function ty_res then
+ if is_optional l && not_nolabel_function ty_res then
Location.prerr_warning (List.hd cases).c_lhs.pat_loc
Warnings.Unerasable_optional_argument;
let param = name_cases "param" cases in
(Warnings.Eliminated_optional_arguments
(List.map (fun (l, _) -> Printtyp.string_of_label l) args));
if warn then Location.prerr_warning texp.exp_loc
- (Warnings.Without_principality "eliminated optional argument");
+ (Warnings.Non_principal_labels "eliminated optional argument");
(* let-expand to have side effects *)
let let_pat, let_var = var_pair "arg" texp.exp_type in
re { texp with exp_type = ty_fun; exp_desc =
if ty_fun.level >= t1.level &&
not (is_prim ~name:"%identity" funct)
then
- Location.prerr_warning sarg.pexp_loc Warnings.Unused_argument;
+ Location.prerr_warning sarg.pexp_loc
+ Warnings.Ignored_extra_argument;
unify env ty_fun (newty (Tarrow(lbl,t1,t2,Clink(ref Cunknown))));
(t1, t2)
| Tarrow (l,t1,t2,_) when l = lbl
in
let eliminate_optional_arg () =
may_warn funct.exp_loc
- (Warnings.Without_principality "eliminated optional argument");
+ (Warnings.Non_principal_labels "eliminated optional argument");
eliminated_optional_arguments :=
(l,ty,lv) :: !eliminated_optional_arguments;
Some (fun () -> option_none env (instance ty) Location.none)
(* No argument was given for this parameter, we abstract over
it. *)
may_warn funct.exp_loc
- (Warnings.Without_principality "commuted an argument");
+ (Warnings.Non_principal_labels "commuted an argument");
omitted_parameters := (l,ty,lv) :: !omitted_parameters;
None
end
: type k . k pattern_category ->
?in_function:_ -> _ -> _ -> _ -> _ -> _ -> Parsetree.case list ->
k case list * partial
- = fun category ?in_function env ty_arg ty_res partial_flag loc caselist ->
+ = fun category ?in_function env
+ ty_arg ty_res_explained partial_flag loc caselist ->
(* ty_arg is _fully_ generalized *)
+ let { ty = ty_res; explanation } = ty_res_explained in
let patterns = List.map (fun {pc_lhs=p} -> p) caselist in
let contains_polyvars = List.exists contains_polymorphic_variant patterns in
let erase_either = contains_polyvars && contains_variant_either ty_arg in
get_current_level ()
in
let take_partial_instance =
- if !Clflags.principal || erase_either
+ if erase_either
then Some false else None
in
begin_def (); (* propagation of the argument *)
Printtyp.raw_type_expr ty_arg; *)
let half_typed_cases =
List.map
- (fun ({pc_lhs; pc_guard; pc_rhs} as case) ->
- let loc =
- let open Location in
- match pc_guard with
- | None -> pc_rhs.pexp_loc
- | Some g -> {pc_rhs.pexp_loc with loc_start=g.pexp_loc.loc_start}
- in
+ (fun ({pc_lhs; pc_guard = _; pc_rhs = _} as case) ->
if !Clflags.principal then begin_def (); (* propagation of pattern *)
- let scope = Some (Annot.Idef loc) in
begin_def ();
let ty_arg = instance ?partial:take_partial_instance ty_arg in
end_def ();
generalize_structure ty_arg;
let (pat, ext_env, force, pvs, unpacks) =
- type_pattern category ~lev env pc_lhs scope ty_arg
+ type_pattern category ~lev env pc_lhs ty_arg
in
pattern_force := force @ !pattern_force;
let pat =
generalize_structure ty; ty
end
else if contains_gadt then
- (* Even though we've already done that, apparently we need to do it
- again.
- stdlib/camlinternalFormat.ml:2288 is an example of use of this
- call to [correct_levels]... *)
+ (* allow propagation from preceding branches *)
correct_levels ty_res
else ty_res in
-(* Format.printf "@[%i %i, ty_res' =@ %a@]@." lev (get_current_level())
- Printtyp.raw_type_expr ty_res'; *)
let guard =
match pc_guard with
| None -> None
(mk_expected ~explanation:When_guard Predef.type_bool))
in
let exp =
- type_unpacks ?in_function ext_env unpacks pc_rhs (mk_expected ty_res')
+ type_unpacks ?in_function ext_env
+ unpacks pc_rhs (mk_expected ?explanation ty_res')
in
{
c_lhs = pat;
?(check = fun s -> Warnings.Unused_var s)
?(check_strict = fun s -> Warnings.Unused_var_strict s)
existential_context
- env rec_flag spat_sexp_list scope allow =
+ env rec_flag spat_sexp_list allow =
let open Ast_helper in
begin_def();
if !Clflags.principal then begin_def ();
spat_sexp_list in
let nvs = List.map (fun _ -> newvar ()) spatl in
let (pat_list, new_env, force, pvs, unpacks) =
- type_pattern_list Value existential_context env spatl scope nvs allow in
+ type_pattern_list Value existential_context env spatl nvs allow in
let attrs_list = List.map fst spatl in
let is_recursive = (rec_flag = Recursive) in
(* If recursive, first unify with an approximation of the expression *)
(* Typing of toplevel bindings *)
-let type_binding env rec_flag spat_sexp_list scope =
+let type_binding env rec_flag spat_sexp_list =
Typetexp.reset_type_variables();
let (pat_exp_list, new_env, _unpacks) =
type_let
~check:(fun s -> Warnings.Unused_value_declaration s)
~check_strict:(fun s -> Warnings.Unused_value_declaration s)
At_toplevel
- env rec_flag spat_sexp_list scope false
+ env rec_flag spat_sexp_list false
in
(pat_exp_list, new_env)
-let type_let existential_ctx env rec_flag spat_sexp_list scope =
+let type_let existential_ctx env rec_flag spat_sexp_list =
let (pat_exp_list, new_env, _unpacks) =
- type_let existential_ctx env rec_flag spat_sexp_list scope false in
+ type_let existential_ctx env rec_flag spat_sexp_list false in
(pat_exp_list, new_env)
(* Typing of toplevel expressions *)
val type_binding:
Env.t -> rec_flag ->
Parsetree.value_binding list ->
- Annot.ident option ->
Typedtree.value_binding list * Env.t
val type_let:
existential_restriction -> Env.t -> rec_flag ->
Parsetree.value_binding list ->
- Annot.ident option ->
Typedtree.value_binding list * Env.t
val type_expression:
Env.t -> Parsetree.expression -> Typedtree.expression
type_manifest =
begin match sdecl.ptype_manifest with None -> None
| Some _ -> Some(Ctype.newvar ()) end;
- type_variance = List.map (fun _ -> Variance.full) sdecl.ptype_params;
+ type_variance = Variance.unknown_signature ~injective:false ~arity;
type_separability = Types.Separability.default_signature ~arity;
type_is_newtype = false;
type_expansion_scope = Btype.lowest_level;
type_kind = kind;
type_private = sdecl.ptype_private;
type_manifest = man;
- type_variance = List.map (fun _ -> Variance.full) params;
+ type_variance = Variance.unknown_signature ~injective:false ~arity;
type_separability = Types.Separability.default_signature ~arity;
type_is_newtype = false;
type_expansion_scope = Btype.lowest_level;
let check_constraints env sdecl (_, decl) =
let visited = ref TypeSet.empty in
+ List.iter2
+ (fun (sty, _) ty -> check_constraints_rec env sty.ptyp_loc visited ty)
+ sdecl.ptype_params decl.type_params;
begin match decl.type_kind with
| Type_abstract -> ()
| Type_variant l ->
(* Check for ill-defined abbrevs *)
-let check_recursion env loc path decl to_check =
+let check_recursion ~orig_env env loc path decl to_check =
(* to_check is true for potentially mutually recursive paths.
(path, decl) is the type declaration to be checked. *)
match ty.desc with
| Tconstr(path', args', _) ->
if Path.same path path' then begin
- if not (Ctype.equal env false args args') then
+ if not (Ctype.equal orig_env false args args') then
raise (Error(loc,
Non_regular {
definition=path;
let (params, body) =
Ctype.instance_parameterized_type params0 body0 in
begin
- try List.iter2 (Ctype.unify env) params args'
+ try List.iter2 (Ctype.unify orig_env) params args'
with Ctype.Unify _ ->
raise (Error(loc, Constraint_failed
(ty, Ctype.newconstr path' params0)));
let (args, body) =
Ctype.instance_parameterized_type
~keep_names:true decl.type_params body in
+ List.iter (check_regular path args [] []) args;
check_regular path args [] [] body)
decl.type_manifest
-let check_abbrev_recursion env id_loc_list to_check tdecl =
+let check_abbrev_recursion ~orig_env env id_loc_list to_check tdecl =
let decl = tdecl.typ_type in
let id = tdecl.typ_id in
- check_recursion env (List.assoc id id_loc_list) (Path.Pident id) decl to_check
+ check_recursion ~orig_env env (List.assoc id id_loc_list) (Path.Pident id)
+ decl to_check
let check_duplicates sdecl_list =
let labels = Hashtbl.create 7 and constrs = Hashtbl.create 7 in
check_well_founded_decl new_env (List.assoc id id_loc_list) (Path.Pident id)
decl to_check)
decls;
- List.iter (check_abbrev_recursion new_env id_loc_list to_check) tdecls;
+ List.iter
+ (check_abbrev_recursion ~orig_env:env new_env id_loc_list to_check) tdecls;
(* Check that all type variables are closed *)
List.iter2
(fun sdecl tdecl ->
raise(Error(cty.ctyp_loc, Inconsistent_constraint (env, tr)))
) tparams sig_decl.type_params;
List.iter (fun (cty, cty', loc) ->
- (* Note: contraints must also be enforced in [sig_env] because
+ (* 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
(* Approximate a type declaration: just make all types abstract *)
-let abstract_type_decl arity =
+let abstract_type_decl ~injective arity =
let rec make_params n =
if n <= 0 then [] else Ctype.newvar() :: make_params (n-1) in
Ctype.begin_def();
type_kind = Type_abstract;
type_private = Public;
type_manifest = None;
- type_variance = replicate_list Variance.full arity;
+ type_variance = Variance.unknown_signature ~injective ~arity;
type_separability = Types.Separability.default_signature ~arity;
type_is_newtype = false;
type_expansion_scope = Btype.lowest_level;
let scope = Ctype.create_scope () in
List.map
(fun sdecl ->
+ let injective = sdecl.ptype_kind <> Ptype_abstract in
(Ident.create_scoped ~scope sdecl.ptype_name.txt,
- abstract_type_decl (List.length sdecl.ptype_params)))
+ abstract_type_decl ~injective (List.length sdecl.ptype_params)))
sdecl_list
(* Variant of check_abbrev_recursion to check the well-formedness
(path, decl) is the type declaration to be checked. *)
let to_check path = Path.exists_free recmod_ids path in
check_well_founded_decl env loc path decl to_check;
- check_recursion env loc path decl to_check;
+ check_recursion ~orig_env:env env loc path decl to_check;
(* additionally check coherece, as one might build an incoherent signature,
and use it to build an incoherent module, cf. #7851 *)
check_coherence env loc path decl
outer_env:Env.t -> Parsetree.type_declaration ->
Typedtree.type_declaration
-val abstract_type_decl: int -> type_declaration
+val abstract_type_decl: injective:bool -> int -> type_declaration
val approx_type_decl:
Parsetree.type_declaration list ->
(Ident.t * type_declaration) list
compute_variance_rec v2 ty)
tl decl.type_variance
with Not_found ->
- List.iter (compute_variance_rec may_inv) tl
+ List.iter (compute_variance_rec unknown) tl
end
| Tobject (ty, _) ->
compute_same ty
| Tvar _ | Tnil | Tlink _ | Tunivar _ -> ()
| Tpackage (_, _, tyl) ->
let v =
- Variance.(if mem Pos vari || mem Neg vari then full else may_inv)
+ Variance.(if mem Pos vari || mem Neg vari then full else unknown)
in
List.iter (compute_variance_rec v) tyl
in
let open Variance in
set May_pos p (set May_neg n (set May_weak n (set Inj i null)))
+let injective = Variance.(set Inj true null)
+
let compute_variance_type env ~check (required, loc) decl tyl =
(* Requirements *)
+ let check_injectivity = decl.type_kind = Type_abstract in
let required =
- List.map (fun (c,n,i) -> if c || n then (c,n,i) else (true,true,i))
+ List.map
+ (fun (c,n,i) ->
+ let i = if check_injectivity then i else false in
+ if c || n then (c,n,i) else (true,true,i))
required
in
(* Prepare *)
(fun (cn,ty) ->
compute_variance env tvl (if cn then full else covariant) ty)
tyl;
+ (* Infer injectivity of constrained parameters *)
+ if check_injectivity then
+ List.iter
+ (fun ty ->
+ if Btype.is_Tvar ty || mem Inj (get_variance ty tvl) then () else
+ let visited = ref TypeSet.empty in
+ let rec check ty =
+ 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
+ | Tvar _ -> raise Exit
+ | Tconstr _ ->
+ let old = !visited in
+ begin try
+ Btype.iter_type_expr check ty
+ with Exit ->
+ visited := old;
+ let ty' = Ctype.expand_head_opt env ty in
+ if ty == ty' then raise Exit else check ty'
+ end
+ | _ -> Btype.iter_type_expr check ty
+ end
+ in
+ try check ty; compute_variance env tvl injective ty
+ with Exit -> ())
+ params;
if check then begin
(* Check variance of parameters *)
let pos = ref 0 in
incr pos;
let var = get_variance ty tvl in
let (co,cn) = get_upper var and ij = mem Inj var in
- if Btype.is_Tvar ty && (co && not c || cn && not n || not ij && i)
+ if Btype.is_Tvar ty && (co && not c || cn && not n) || not ij && i
then raise (Error(loc, Bad_variance
(Variance_not_satisfied !pos,
(co,cn,ij),
check;
}
-let transl_variance : Asttypes.variance -> _ = function
- | Covariant -> (true, false, false)
- | Contravariant -> (false, true, false)
- | Invariant -> (false, false, false)
+let transl_variance (v, i) =
+ let co, cn =
+ match v with
+ | Covariant -> (true, false)
+ | Contravariant -> (false, true)
+ | NoVariance -> (false, false)
+ in
+ (co, cn, match i with Injective -> true | NoInjectivity -> false)
let variance_of_params ptype_params =
List.map transl_variance (List.map snd ptype_params)
type surface_variance = bool * bool * bool
val variance_of_params :
- (Parsetree.core_type * Asttypes.variance) list -> surface_variance list
+ (Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list ->
+ surface_variance list
val variance_of_sdecl :
Parsetree.type_declaration -> surface_variance list
and type_declaration =
{ typ_id: Ident.t;
typ_name: string loc;
- typ_params: (core_type * variance) list;
+ typ_params: (core_type * (variance * injectivity)) list;
typ_type: Types.type_declaration;
typ_cstrs: (core_type * core_type * Location.t) list;
typ_kind: type_kind;
{
tyext_path: Path.t;
tyext_txt: Longident.t loc;
- tyext_params: (core_type * variance) list;
+ tyext_params: (core_type * (variance * injectivity)) list;
tyext_constructors: extension_constructor list;
tyext_private: private_flag;
tyext_loc: Location.t;
and 'a class_infos =
{ ci_virt: virtual_flag;
- ci_params: (core_type * variance) list;
+ ci_params: (core_type * (variance * injectivity)) list;
ci_id_name: string loc;
ci_id_class: Ident.t;
ci_id_class_type: Ident.t;
| Value -> f p
| Computation -> () }
-let rec map_general_pattern
- : type k . pattern_transformation -> k general_pattern -> k general_pattern
- = fun f p ->
- let pat_desc =
- shallow_map_pattern_desc
- { f = fun p -> map_general_pattern f p }
- p.pat_desc in
- f.f { p with pat_desc }
-
type pattern_predicate = { f : 'k . 'k general_pattern -> bool }
let exists_general_pattern (f : pattern_predicate) p =
let exception Found in
{
typ_id: Ident.t;
typ_name: string loc;
- typ_params: (core_type * variance) list;
+ typ_params: (core_type * (variance * injectivity)) list;
typ_type: Types.type_declaration;
typ_cstrs: (core_type * core_type * Location.t) list;
typ_kind: type_kind;
{
tyext_path: Path.t;
tyext_txt: Longident.t loc;
- tyext_params: (core_type * variance) list;
+ tyext_params: (core_type * (variance * injectivity)) list;
tyext_constructors: extension_constructor list;
tyext_private: private_flag;
tyext_loc: Location.t;
and 'a class_infos =
{ ci_virt: virtual_flag;
- ci_params: (core_type * variance) list;
+ ci_params: (core_type * (variance * injectivity)) list;
ci_id_name : string loc;
ci_id_class: Ident.t;
ci_id_class_type : Ident.t;
val exists_general_pattern: pattern_predicate -> 'k general_pattern -> bool
val exists_pattern: (pattern -> bool) -> pattern -> bool
-(** bottom-up mapping of patterns: the transformation function is
- called on the children before being called on the parent *)
-val map_general_pattern:
- pattern_transformation -> 'k general_pattern -> 'k general_pattern
-
val let_bound_idents: value_binding list -> Ident.t list
val let_bound_idents_full:
value_binding list -> (Ident.t * string loc * Types.type_expr) list
| Recursive_module_require_explicit_type
| Apply_generative
| Cannot_scrape_alias of Path.t
+ | Cannot_scrape_package_type of Path.t
| Badly_formed_signature of string * Typedecl.error
| Cannot_hide_id of hiding_error
| Invalid_type_subst_rhs
env
in
let units =
- List.rev_map Env.persistent_structures_of_dir (Load_path.get ())
+ List.map Env.persistent_structures_of_dir (Load_path.get ())
in
let env, units =
match initially_opened_module with
type_manifest = None;
type_variance =
List.map
- (fun (_, v) ->
+ (fun (_, (v, i)) ->
let (c, n) =
match v with
| Covariant -> true, false
| Contravariant -> false, true
- | Invariant -> false, false
+ | NoVariance -> false, false
in
- make_variance (not n) (not c) false
+ make_variance (not n) (not c) (i = Injective)
)
sdecl.ptype_params;
type_separability =
(* Helper for unpack *)
-let rec package_constraints env loc mty constrs =
+let rec package_constraints_sig env loc sg constrs =
+ List.map
+ (function
+ | Sig_type (id, ({type_params=[]} as td), rs, priv)
+ when List.mem_assoc [Ident.name id] constrs ->
+ let ty = List.assoc [Ident.name id] constrs in
+ Sig_type (id, {td with type_manifest = Some ty}, rs, priv)
+ | Sig_module (id, pres, md, rs, priv) ->
+ let rec aux = function
+ | (m :: ((_ :: _) as l), t) :: rest when m = Ident.name id ->
+ (l, t) :: aux rest
+ | _ :: rest -> aux rest
+ | [] -> []
+ in
+ let md =
+ {md with
+ md_type = package_constraints env loc md.md_type (aux constrs)
+ }
+ in
+ Sig_module (id, pres, md, rs, priv)
+ | item -> item
+ )
+ sg
+
+and package_constraints env loc mty constrs =
if constrs = [] then mty
- else let sg = extract_sig env loc mty in
- let sg' =
- List.map
- (function
- | Sig_type (id, ({type_params=[]} as td), rs, priv)
- when List.mem_assoc [Ident.name id] constrs ->
- let ty = List.assoc [Ident.name id] constrs in
- Sig_type (id, {td with type_manifest = Some ty}, rs, priv)
- | Sig_module (id, _, md, rs, priv) ->
- let rec aux = function
- | (m :: ((_ :: _) as l), t) :: rest when m = Ident.name id ->
- (l, t) :: aux rest
- | _ :: rest -> aux rest
- | [] -> []
- in
- let md =
- {md with
- md_type = package_constraints env loc md.md_type (aux constrs)
- }
- in
- Sig_module (id, Mp_present, md, rs, priv)
- | item -> item
- )
- sg
- in
- Mty_signature sg'
+ else begin
+ match Mtype.scrape env mty with
+ | Mty_signature sg ->
+ Mty_signature (package_constraints_sig env loc sg constrs)
+ | Mty_functor _ | Mty_alias _ -> assert false
+ | Mty_ident p -> raise(Error(loc, env, Cannot_scrape_package_type p))
+ end
let modtype_of_package env loc p nl tl =
- match (Env.find_modtype p env).mtd_type with
- | Some mty when nl <> [] ->
- package_constraints env loc mty
- (List.combine (List.map Longident.flatten nl) tl)
- | _ | exception Not_found (* missing cmi *) ->
- if nl = [] then Mty_ident p
- else raise(Error(loc, env, Signature_expected))
+ package_constraints env loc (Mty_ident p)
+ (List.combine (List.map Longident.flatten nl) tl)
let package_subtype env p1 nl1 tl1 p2 nl2 tl2 =
let mkmty p nl tl =
let (nl, tl) = List.split ntl in
modtype_of_package env Location.none p nl tl
in
- let mty1 = mkmty p1 nl1 tl1 and mty2 = mkmty p2 nl2 tl2 in
- let loc = Location.none in
- match Includemod.modtypes ~loc ~mark:Mark_both env mty1 mty2 with
- | Tcoerce_none -> true
- | _ | exception Includemod.Error _ -> false
+ match mkmty p1 nl1 tl1, mkmty p2 nl2 tl2 with
+ | exception Error(_, _, Cannot_scrape_package_type _) -> false
+ | mty1, mty2 ->
+ let loc = Location.none in
+ match Includemod.modtypes ~loc ~mark:Mark_both env mty1 mty2 with
+ | Tcoerce_none -> true
+ | _ | exception Includemod.Error _ -> false
let () = Ctype.package_subtype := package_subtype
in md
| Pmod_structure sstr ->
let (str, sg, names, _finalenv) =
- type_structure funct_body anchor env sstr smod.pmod_loc in
+ type_structure funct_body anchor env sstr in
let md =
{ mod_desc = Tmod_structure str;
mod_type = Mty_signature sg;
} in
open_descr, sg, newenv
-and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
+and type_structure ?(toplevel = false) funct_body anchor env sstr =
let names = Signature_names.create () in
- let type_str_item env srem {pstr_loc = loc; pstr_desc = desc} =
+ let type_str_item env {pstr_loc = loc; pstr_desc = desc} =
match desc with
| Pstr_eval (sexpr, attrs) ->
let expr =
in
Tstr_eval (expr, attrs), [], env
| Pstr_value(rec_flag, sdefs) ->
- let scope =
- match rec_flag with
- | Recursive ->
- Some (Annot.Idef {scope with
- Location.loc_start = loc.Location.loc_start})
- | Nonrecursive ->
- let start =
- match srem with
- | [] -> loc.Location.loc_end
- | {pstr_loc = loc2} :: _ -> loc2.Location.loc_start
- in
- Some (Annot.Idef {scope with Location.loc_start = start})
- in
let (defs, newenv) =
- Typecore.type_binding env rec_flag sdefs scope in
+ Typecore.type_binding env rec_flag sdefs in
let () = if rec_flag = Recursive then
Typecore.check_recursive_bindings env defs
in
| [] -> ([], [], env)
| pstr :: srem ->
let previous_saved_types = Cmt_format.get_saved_types () in
- let desc, sg, new_env = type_str_item env srem pstr in
+ let desc, sg, new_env = type_str_item env 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 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 Location.none in
+ type_structure ~toplevel:true false None env s in
(str, sg, to_remove_from_sg, env)
let type_module_alias = type_module ~alias:true true false None
(* Normalize types in a signature *)
-let rec normalize_modtype env = function
+let rec normalize_modtype = function
Mty_ident _
| Mty_alias _ -> ()
- | Mty_signature sg -> normalize_signature env sg
- | Mty_functor(_param, body) -> normalize_modtype env body
+ | Mty_signature sg -> normalize_signature sg
+ | Mty_functor(_param, body) -> normalize_modtype body
-and normalize_signature env = List.iter (normalize_signature_item env)
+and normalize_signature sg = List.iter normalize_signature_item sg
-and normalize_signature_item env = function
- Sig_value(_id, desc, _) -> Ctype.normalize_type env desc.val_type
- | Sig_module(_id, _, md, _, _) -> normalize_modtype env md.md_type
+and normalize_signature_item = function
+ Sig_value(_id, desc, _) -> Ctype.normalize_type desc.val_type
+ | Sig_module(_id, _, md, _, _) -> normalize_modtype md.md_type
| _ -> ()
(* Extract the module type of a module expression *)
if !Clflags.print_types then (* #7656 *)
Warnings.parse_options false "-32-34-37-38-60";
let (str, sg, names, finalenv) =
- type_structure initial_env ast (Location.in_file sourcefile) in
+ type_structure initial_env ast in
let simple_sg = Signature_names.simplify finalenv names sg in
if !Clflags.print_types then begin
Typecore.force_delayed_checks ();
sourcefile sg "(inferred signature)" simple_sg
in
check_nongen_schemes finalenv simple_sg;
- normalize_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
fprintf ppf
"This is an alias for module %a, which is missing"
path p
+ | Cannot_scrape_package_type p ->
+ fprintf ppf
+ "The type of this packed module refers to %a, which is missing"
+ path p
| Badly_formed_signature (context, err) ->
fprintf ppf "@[In %s:@ %a@]" context Typedecl.report_error err
| Cannot_hide_id Illegal_shadowing
val type_module:
Env.t -> Parsetree.module_expr -> Typedtree.module_expr
val type_structure:
- Env.t -> Parsetree.structure -> Location.t ->
+ Env.t -> Parsetree.structure ->
Typedtree.structure * Types.signature * Signature_names.t * Env.t
val type_toplevel_phrase:
Env.t -> Parsetree.structure ->
| Recursive_module_require_explicit_type
| Apply_generative
| Cannot_scrape_alias of Path.t
+ | Cannot_scrape_package_type of Path.t
| Badly_formed_signature of string * Typedecl.error
| Cannot_hide_id of hiding_error
| Invalid_type_subst_rhs
if b then v lor single x else v land (lnot (single x))
let mem x = subset (single x)
let null = 0
- let may_inv = 7
+ let unknown = 7
let full = 127
let covariant = single May_pos lor single Pos lor single Inj
let swap f1 f2 v =
let conjugate v = swap May_pos May_neg (swap Pos Neg v)
let get_upper v = (mem May_pos v, mem May_neg v)
let get_lower v = (mem Pos v, mem Neg v, mem Inv v, mem Inj v)
+ let unknown_signature ~injective ~arity =
+ let v = if injective then set Inj true unknown else unknown in
+ Misc.replicate_list v arity
end
module Separability = struct
let default_signature ~arity =
let default_mode = if Config.flat_float_array then Deepsep else Ind in
- List.init arity (fun _ -> default_mode)
+ Misc.replicate_list default_mode arity
end
(* Type definitions *)
module Variance : sig
type t
- type f = May_pos | May_neg | May_weak | Inj | Pos | Neg | Inv
- val null : t (* no occurrence *)
- val full : t (* strictly invariant *)
- val covariant : t (* strictly covariant *)
- val may_inv : t (* maybe invariant *)
+ type f =
+ May_pos (* allow positive occurrences *)
+ | May_neg (* allow negative occurrences *)
+ | May_weak (* allow occurrences under a negative position *)
+ | Inj (* type is injective in this parameter *)
+ | Pos (* there is a positive occurrence *)
+ | Neg (* there is a negative occurrence *)
+ | Inv (* both negative and positive occurrences *)
+ val null : t (* no occurrence *)
+ val full : t (* strictly invariant (all flags) *)
+ val covariant : t (* strictly covariant (May_pos, Pos and Inj) *)
+ val unknown : t (* allow everything, guarantee nothing *)
val union : t -> t -> t
val inter : t -> t -> t
val subset : t -> t -> bool
val conjugate : t -> t (* exchange positive and negative *)
val get_upper : t -> bool * bool (* may_pos, may_neg *)
val get_lower : t -> bool * bool * bool * bool (* pos, neg, inv, inj *)
+ val unknown_signature : injective:bool -> arity:int -> t list
+ (** The most pessimistic variance for a completely unknown type. *)
end
module Separability : sig
{desc=Tconstr(p, tl, _)} -> Some(p, tl)
| _ -> None
in
- begin try
- (* Set name if there are no fields yet *)
- Hashtbl.iter (fun _ _ -> raise Exit) hfields;
- name := nm
- with Exit ->
- (* Unset it otherwise *)
- name := None
- end;
+ 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
let transl_simple_type_delayed env styp =
univars := []; used_variables := TyVarMap.empty;
+ begin_def ();
let typ = transl_type env Extensible styp in
+ end_def ();
make_fixed_univars typ.ctyp_type;
- (typ, globalize_used_variables env false)
+ (* This brings the used variables to the global level, but doesn't link them
+ to their other occurrences just yet. This will be done when [force] is
+ called. *)
+ let force = globalize_used_variables env false in
+ (* Generalizes everything except the variables that were just globalized. *)
+ generalize typ.ctyp_type;
+ (typ, instance typ.ctyp_type, force)
let transl_type_scheme env styp =
reset_type_variables();
Env.t -> bool -> Parsetree.core_type -> Typedtree.core_type
val transl_simple_type_univars:
Env.t -> Parsetree.core_type -> Typedtree.core_type
-val transl_simple_type_delayed:
- Env.t -> Parsetree.core_type -> Typedtree.core_type * (unit -> unit)
+val transl_simple_type_delayed
+ : Env.t
+ -> Parsetree.core_type
+ -> Typedtree.core_type * type_expr * (unit -> unit)
(* Translate a type, but leave type variables unbound. Returns
- the type and a function that binds the type variable. *)
+ the type, an instance of the corresponding type_expr, and a
+ function that binds the type variable. *)
val transl_type_scheme:
Env.t -> Parsetree.core_type -> Typedtree.core_type
val reset_type_variables: unit -> unit
let untype_signature ?(mapper=default_mapper) signature =
mapper.signature mapper signature
+
+let untype_expression ?(mapper=default_mapper) expression =
+ mapper.expr mapper expression
+
+let untype_pattern ?(mapper=default_mapper) pattern =
+ mapper.pat mapper pattern
val untype_structure : ?mapper:mapper -> Typedtree.structure -> structure
val untype_signature : ?mapper:mapper -> Typedtree.signature -> signature
+val untype_expression : ?mapper:mapper -> Typedtree.expression -> expression
+val untype_pattern : ?mapper:mapper -> _ Typedtree.general_pattern -> pattern
val constant : Asttypes.constant -> Parsetree.constant
ROOTDIR = ..
-include $(ROOTDIR)/Makefile.config
+include $(ROOTDIR)/Makefile.common
ifeq "$(UNIX_OR_WIN32)" "win32"
ifeq "$(wildcard $(ROOTDIR)/flexdll/Makefile)" ""
FLEXLINK_FLAGS ?=
-# Escape special characters in the argument string.
-# There are four characters that need escaping:
-# - backslash and ampersand, which are special in the replacement text
-# of sed's "s" command
-# - exclamation mark, which is the delimiter we use for sed's "s" command
-# - single quote, which interferes with shell quoting. We are inside
-# single quotes already, so the proper escape is '\''
-# (close single quotation, insert single quote character,
-# reopen single quotation).
-SED_ESCAPE=$(subst ','\'',$(subst !,\!,$(subst &,\&,$(subst \,\\,$1))))
-
-# Escape special characters in an OCaml string literal "..."
-# There are two: backslash and double quote.
-OCAML_ESCAPE=$(subst ",\",$(subst \,\\,$1))
-
-# SUBST generates the sed substitution for the variable *named* in $1
-SUBST=-e 's!%%$1%%!$(call SED_ESCAPE,$($1))!'
-
-# SUBST_STRING does the same, for a variable that occurs between "..."
-# in config.mlp. Thus, backslashes and double quotes must be escaped.
-SUBST_STRING=-e 's!%%$1%%!$(call SED_ESCAPE,$(call OCAML_ESCAPE,$($1)))!'
-
-# SUBST_QUOTE does the same, adding OCaml quotes around non-empty strings
-# (see FLEXDLL_DIR which must empty if FLEXDLL_DIR is empty but an OCaml
-# string otherwise)
+# SUBST_QUOTE does the same as SUBST_STRING, adding OCaml quotes around
+# non-empty strings (see FLEXDLL_DIR which must empty if FLEXDLL_DIR is empty
+# but an OCaml string otherwise)
SUBST_QUOTE2=\
-e 's!%%$1%%!$(if $2,$(call SED_ESCAPE,"$(call OCAML_ESCAPE,$2)"))!'
SUBST_QUOTE=$(call SUBST_QUOTE2,$1,$($1))
FLEXLINK_LDFLAGS=$(if $(OC_LDFLAGS), -link "$(OC_LDFLAGS)")
+FLEXLINK_DLL_LDFLAGS=$(if $(OC_DLL_LDFLAGS), -link "$(OC_DLL_LDFLAGS)")
config.ml: config.mlp $(ROOTDIR)/Makefile.config Makefile
sed $(call SUBST,AFL_INSTRUMENT) \
$(call SUBST_QUOTE,FLEXDLL_DIR) \
$(call SUBST,HOST) \
$(call SUBST_STRING,LIBDIR) \
- $(call SUBST,LIBUNWIND_AVAILABLE) \
- $(call SUBST,LIBUNWIND_LINK_FLAGS) \
$(call SUBST_STRING,MKDLL) \
$(call SUBST_STRING,MKEXE) \
$(call SUBST_STRING,FLEXLINK_LDFLAGS) \
+ $(call SUBST_STRING,FLEXLINK_DLL_LDFLAGS) \
$(call SUBST_STRING,MKMAINDLL) \
$(call SUBST,MODEL) \
$(call SUBST_STRING,NATIVECCLIBS) \
$(call SUBST,TARGET) \
$(call SUBST,WITH_FRAME_POINTERS) \
$(call SUBST,WITH_PROFINFO) \
- $(call SUBST,WITH_SPACETIME) \
- $(call SUBST,ENABLE_CALL_COUNTS) \
$(call SUBST,FLAT_FLOAT_ARRAY) \
$(call SUBST,FUNCTION_SECTIONS) \
$(call SUBST,CC_HAS_DEBUG_PREFIX_MAP) \
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Nicolas Ojeda Bar, LexiFi *)
+(* *)
+(* Copyright 2020 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+let char_to_hex c =
+ Printf.sprintf "0x%02x" (Char.code c)
+
+let int_to_hex n =
+ Printf.sprintf "0x%x" n
+
+type error =
+ | Truncated_file
+ | Unrecognized of string
+ | Unsupported of string * int64
+ | Out_of_range of string
+
+let error_to_string = function
+ | Truncated_file ->
+ "Truncated file"
+ | Unrecognized magic ->
+ Printf.sprintf "Unrecognized magic: %s"
+ (String.concat " "
+ (List.init (String.length magic)
+ (fun i -> char_to_hex magic.[i])))
+ | Unsupported (s, n) ->
+ Printf.sprintf "Unsupported: %s: 0x%Lx" s n
+ | Out_of_range s ->
+ Printf.sprintf "Out of range constant: %s" s
+
+exception Error of error
+
+let name_at ?max_len buf start =
+ if start < 0 || start > Bytes.length buf then
+ raise (Error (Out_of_range (int_to_hex start)));
+ let max_pos =
+ match max_len with
+ | None -> Bytes.length buf
+ | Some n -> min (Bytes.length buf) (start + n)
+ in
+ let rec loop pos =
+ if pos >= max_pos || Bytes.get buf pos = '\000'
+ then
+ Bytes.sub_string buf start (pos - start)
+ else
+ loop (succ pos)
+ in
+ loop start
+
+let array_find_map f a =
+ let rec loop i =
+ if i >= Array.length a then None
+ else begin
+ match f a.(i) with
+ | None -> loop (succ i)
+ | Some _ as r -> r
+ end
+ in
+ loop 0
+
+let array_find f a =
+ array_find_map (fun x -> if f x then Some x else None) a
+
+let really_input_bytes ic len =
+ let buf = Bytes.create len in
+ really_input ic buf 0 len;
+ buf
+
+let uint64_of_uint32 n =
+ Int64.(logand (of_int32 n) 0xffffffffL)
+
+type endianness =
+ | LE
+ | BE
+
+type bitness =
+ | B32
+ | B64
+
+type decoder =
+ {
+ ic: in_channel;
+ endianness: endianness;
+ bitness: bitness;
+ }
+
+let word_size = function
+ | {bitness = B64; _} -> 8
+ | {bitness = B32; _} -> 4
+
+let get_uint16 {endianness; _} buf idx =
+ match endianness with
+ | LE -> Bytes.get_uint16_le buf idx
+ | BE -> Bytes.get_uint16_be buf idx
+
+let get_uint32 {endianness; _} buf idx =
+ match endianness with
+ | LE -> Bytes.get_int32_le buf idx
+ | BE -> Bytes.get_int32_be buf idx
+
+let get_uint s d buf idx =
+ let n = get_uint32 d buf idx in
+ match Int32.unsigned_to_int n with
+ | None -> raise (Error (Unsupported (s, Int64.of_int32 n)))
+ | Some n -> n
+
+let get_uint64 {endianness; _} buf idx =
+ match endianness with
+ | LE -> Bytes.get_int64_le buf idx
+ | BE -> Bytes.get_int64_be buf idx
+
+let get_word d buf idx =
+ match d.bitness with
+ | B64 -> get_uint64 d buf idx
+ | B32 -> uint64_of_uint32 (get_uint32 d buf idx)
+
+let uint64_to_int s n =
+ match Int64.unsigned_to_int n with
+ | None -> raise (Error (Unsupported (s, n)))
+ | Some n -> n
+
+let load_bytes d off len =
+ LargeFile.seek_in d.ic off;
+ really_input_bytes d.ic len
+
+type t =
+ {
+ defines_symbol: string -> bool;
+ symbol_offset: string -> int64 option;
+ }
+
+module ELF = struct
+
+ (* Reference: http://man7.org/linux/man-pages/man5/elf.5.html *)
+
+ let header_size d =
+ 40 + 3 * word_size d
+
+ type header =
+ {
+ e_shoff: int64;
+ e_shentsize: int;
+ e_shnum: int;
+ e_shstrndx: int;
+ }
+
+ let read_header d =
+ let buf = load_bytes d 0L (header_size d) in
+ let word_size = word_size d in
+ let e_shnum = get_uint16 d buf (36 + 3 * word_size) in
+ let e_shentsize = get_uint16 d buf (34 + 3 * word_size) in
+ let e_shoff = get_word d buf (24 + 2 * word_size) in
+ let e_shstrndx = get_uint16 d buf (38 + 3 * word_size) in
+ {e_shnum; e_shentsize; e_shoff; e_shstrndx}
+
+ type sh_type =
+ | SHT_STRTAB
+ | SHT_DYNSYM
+ | SHT_OTHER
+
+ type section =
+ {
+ sh_name: int;
+ sh_type: sh_type;
+ sh_addr: int64;
+ sh_offset: int64;
+ sh_size: int;
+ sh_entsize: int;
+ sh_name_str: string;
+ }
+
+ let load_section_body d {sh_offset; sh_size; _} =
+ load_bytes d sh_offset sh_size
+
+ let read_sections d {e_shoff; e_shnum; e_shentsize; e_shstrndx; _} =
+ let buf = load_bytes d e_shoff (e_shnum * e_shentsize) in
+ let word_size = word_size d in
+ let mk i =
+ let base = i * e_shentsize in
+ let sh_name = get_uint "sh_name" d buf (base + 0) in
+ let sh_type =
+ match get_uint32 d buf (base + 4) with
+ | 3l -> SHT_STRTAB
+ | 11l -> SHT_DYNSYM
+ | _ -> SHT_OTHER
+ in
+ let sh_addr = get_word d buf (base + 8 + word_size) in
+ let sh_offset = get_word d buf (base + 8 + 2 * word_size) in
+ let sh_size =
+ uint64_to_int "sh_size"
+ (get_word d buf (base + 8 + 3 * word_size))
+ in
+ let sh_entsize =
+ uint64_to_int "sh_entsize"
+ (get_word d buf (base + 16 + 5 * word_size))
+ in
+ {sh_name; sh_type; sh_addr; sh_offset;
+ sh_size; sh_entsize; sh_name_str = ""}
+ in
+ let sections = Array.init e_shnum mk in
+ if e_shstrndx = 0 then
+ (* no string table *)
+ sections
+ else
+ let shstrtbl = load_section_body d sections.(e_shstrndx) in
+ let set_name sec =
+ let sh_name_str = name_at shstrtbl sec.sh_name in
+ {sec with sh_name_str}
+ in
+ Array.map set_name sections
+
+ let read_sections d h =
+ let {e_shoff; e_shentsize; e_shnum; e_shstrndx} = h in
+ if e_shoff = 0L then
+ [||]
+ else begin
+ let buf = lazy (load_bytes d e_shoff e_shentsize) in
+ let word_size = word_size d in
+ let e_shnum =
+ if e_shnum = 0 then
+ (* The real e_shnum is the sh_size of the initial section.*)
+ uint64_to_int "e_shnum"
+ (get_word d (Lazy.force buf) (8 + 3 * word_size))
+ else
+ e_shnum
+ in
+ let e_shstrndx =
+ if e_shstrndx = 0xffff then
+ (* The real e_shstrndx is the sh_link of the initial section. *)
+ get_uint "e_shstrndx" d (Lazy.force buf) (8 + 4 * word_size)
+ else
+ e_shstrndx
+ in
+ read_sections d {h with e_shnum; e_shstrndx}
+ end
+
+ type symbol =
+ {
+ st_name: string;
+ st_value: int64;
+ st_shndx: int;
+ }
+
+ let find_section sections type_ sectname =
+ let f {sh_type; sh_name_str; _} =
+ sh_type = type_ && sh_name_str = sectname
+ in
+ array_find f sections
+
+ let read_symbols d sections =
+ match find_section sections SHT_DYNSYM ".dynsym" with
+ | None -> [| |]
+ | Some {sh_entsize = 0; _} ->
+ raise (Error (Out_of_range "sh_entsize=0"))
+ | Some dynsym ->
+ begin match find_section sections SHT_STRTAB ".dynstr" with
+ | None -> [| |]
+ | Some dynstr ->
+ let strtbl = load_section_body d dynstr in
+ let buf = load_section_body d dynsym in
+ let word_size = word_size d in
+ let mk i =
+ let base = i * dynsym.sh_entsize in
+ let st_name = name_at strtbl (get_uint "st_name" d buf base) in
+ let st_value = get_word d buf (base + word_size (* ! *)) in
+ let st_shndx =
+ let off = match d.bitness with B64 -> 6 | B32 -> 14 in
+ get_uint16 d buf (base + off)
+ in
+ {st_name; st_value; st_shndx}
+ in
+ Array.init (dynsym.sh_size / dynsym.sh_entsize) mk
+ end
+
+ let find_symbol symbols symname =
+ let f = function
+ | {st_shndx = 0; _} -> false
+ | {st_name; _} -> st_name = symname
+ in
+ array_find f symbols
+
+ let symbol_offset sections symbols symname =
+ match find_symbol symbols symname with
+ | None ->
+ None
+ | Some {st_shndx; st_value; _} ->
+ (* st_value in executables and shared objects holds a virtual (absolute)
+ address. See https://refspecs.linuxfoundation.org/elf/elf.pdf, page
+ 1-21, "Symbol Values". *)
+ Some Int64.(add sections.(st_shndx).sh_offset
+ (sub st_value sections.(st_shndx).sh_addr))
+
+ let defines_symbol symbols symname =
+ Option.is_some (find_symbol symbols symname)
+
+ let read ic =
+ seek_in ic 0;
+ let identification = really_input_bytes ic 16 in
+ let bitness =
+ match Bytes.get identification 4 with
+ | '\x01' -> B32
+ | '\x02' -> B64
+ | _ as c ->
+ raise (Error (Unsupported ("ELFCLASS", Int64.of_int (Char.code c))))
+ in
+ let endianness =
+ match Bytes.get identification 5 with
+ | '\x01' -> LE
+ | '\x02' -> BE
+ | _ as c ->
+ raise (Error (Unsupported ("ELFDATA", Int64.of_int (Char.code c))))
+ in
+ let d = {ic; bitness; endianness} in
+ let header = read_header d in
+ let sections = read_sections d header in
+ let symbols = read_symbols d sections in
+ let symbol_offset = symbol_offset sections symbols in
+ let defines_symbol = defines_symbol symbols in
+ {symbol_offset; defines_symbol}
+end
+
+module Mach_O = struct
+
+ (* Reference:
+ https://github.com/aidansteele/osx-abi-macho-file-format-reference *)
+
+ let size_int = 4
+
+ let header_size {bitness; _} =
+ (match bitness with B64 -> 6 | B32 -> 5) * 4 + 2 * size_int
+
+ type header =
+ {
+ ncmds: int;
+ sizeofcmds: int;
+ }
+
+ let read_header d =
+ let buf = load_bytes d 0L (header_size d) in
+ let ncmds = get_uint "ncmds" d buf (8 + 2 * size_int) in
+ let sizeofcmds = get_uint "sizeofcmds" d buf (12 + 2 * size_int) in
+ {ncmds; sizeofcmds}
+
+ type lc_symtab =
+ {
+ symoff: int32;
+ nsyms: int;
+ stroff: int32;
+ strsize: int;
+ }
+
+ type load_command =
+ | LC_SYMTAB of lc_symtab
+ | OTHER
+
+ let read_load_commands d {ncmds; sizeofcmds} =
+ let buf = load_bytes d (Int64.of_int (header_size d)) sizeofcmds in
+ let base = ref 0 in
+ let mk _ =
+ let cmd = get_uint32 d buf (!base + 0) in
+ let cmdsize = get_uint "cmdsize" d buf (!base + 4) in
+ let lc =
+ match cmd with
+ | 0x2l ->
+ let symoff = get_uint32 d buf (!base + 8) in
+ let nsyms = get_uint "nsyms" d buf (!base + 12) in
+ let stroff = get_uint32 d buf (!base + 16) in
+ let strsize = get_uint "strsize" d buf (!base + 20) in
+ LC_SYMTAB {symoff; nsyms; stroff; strsize}
+ | _ ->
+ OTHER
+ in
+ base := !base + cmdsize;
+ lc
+ in
+ Array.init ncmds mk
+
+ type symbol =
+ {
+ n_name: string;
+ n_type: int;
+ n_value: int64;
+ }
+
+ let size_nlist d =
+ 8 + word_size d
+
+ let read_symbols d load_commands =
+ match
+ (* Can it happen there be more than one LC_SYMTAB? *)
+ array_find_map (function
+ | LC_SYMTAB symtab -> Some symtab
+ | _ -> None
+ ) load_commands
+ with
+ | None -> [| |]
+ | Some {symoff; nsyms; stroff; strsize} ->
+ let strtbl = load_bytes d (uint64_of_uint32 stroff) strsize in
+ let buf =
+ load_bytes d (uint64_of_uint32 symoff) (nsyms * size_nlist d) in
+ let size_nlist = size_nlist d in
+ let mk i =
+ let base = i * size_nlist in
+ let n_name = name_at strtbl (get_uint "n_name" d buf (base + 0)) in
+ let n_type = Bytes.get_uint8 buf (base + 4) in
+ let n_value = get_word d buf (base + 8) in
+ {n_name; n_type; n_value}
+ in
+ Array.init nsyms mk
+
+ let fix symname =
+ "_" ^ symname
+
+ let find_symbol symbols symname =
+ let f {n_name; n_type; _} =
+ n_type land 0b1111 = 0b1111 (* N_EXT + N_SECT *) &&
+ n_name = symname
+ in
+ array_find f symbols
+
+ let symbol_offset symbols symname =
+ let symname = fix symname in
+ match find_symbol symbols symname with
+ | None -> None
+ | Some {n_value; _} -> Some n_value
+
+ let defines_symbol symbols symname =
+ let symname = fix symname in
+ Option.is_some (find_symbol symbols symname)
+
+ type magic =
+ | MH_MAGIC
+ | MH_CIGAM
+ | MH_MAGIC_64
+ | MH_CIGAM_64
+
+ let read ic =
+ seek_in ic 0;
+ let magic = really_input_bytes ic 4 in
+ let magic =
+ match Bytes.get_int32_ne magic 0 with
+ | 0xFEEDFACEl -> MH_MAGIC
+ | 0xCEFAEDFEl -> MH_CIGAM
+ | 0xFEEDFACFl -> MH_MAGIC_64
+ | 0xCFFAEDFEl -> MH_CIGAM_64
+ | _ -> (* should not happen *)
+ raise (Error (Unrecognized (Bytes.to_string magic)))
+ in
+ let bitness =
+ match magic with
+ | MH_MAGIC | MH_CIGAM -> B32
+ | MH_MAGIC_64 | MH_CIGAM_64 -> B64
+ in
+ let endianness =
+ match magic, Sys.big_endian with
+ | (MH_MAGIC | MH_MAGIC_64), false
+ | (MH_CIGAM | MH_CIGAM_64), true -> LE
+ | (MH_MAGIC | MH_MAGIC_64), true
+ | (MH_CIGAM | MH_CIGAM_64), false -> BE
+ in
+ let d = {ic; endianness; bitness} in
+ let header = read_header d in
+ let load_commands = read_load_commands d header in
+ let symbols = read_symbols d load_commands in
+ let symbol_offset = symbol_offset symbols in
+ let defines_symbol = defines_symbol symbols in
+ {symbol_offset; defines_symbol}
+end
+
+module FlexDLL = struct
+
+ (* Reference:
+ https://docs.microsoft.com/en-us/windows/win32/debug/pe-format *)
+
+ let header_size = 24
+
+ type header =
+ {
+ e_lfanew: int64;
+ number_of_sections: int;
+ size_of_optional_header: int;
+ characteristics: int;
+ }
+
+ let read_header e_lfanew d buf =
+ let number_of_sections = get_uint16 d buf 6 in
+ let size_of_optional_header = get_uint16 d buf 20 in
+ let characteristics = get_uint16 d buf 22 in
+ {e_lfanew; number_of_sections; size_of_optional_header; characteristics}
+
+ type optional_header_magic =
+ | PE32
+ | PE32PLUS
+
+ type optional_header =
+ {
+ magic: optional_header_magic;
+ image_base: int64;
+ }
+
+ let read_optional_header d {e_lfanew; size_of_optional_header; _} =
+ if size_of_optional_header = 0 then
+ raise (Error (Unrecognized "SizeOfOptionalHeader=0"));
+ let buf =
+ load_bytes d Int64.(add e_lfanew (of_int header_size))
+ size_of_optional_header
+ in
+ let magic =
+ match get_uint16 d buf 0 with
+ | 0x10b -> PE32
+ | 0x20b -> PE32PLUS
+ | n ->
+ raise (Error (Unsupported ("optional_header_magic", Int64.of_int n)))
+ in
+ let image_base =
+ match magic with
+ | PE32 -> uint64_of_uint32 (get_uint32 d buf 28)
+ | PE32PLUS -> get_uint64 d buf 24
+ in
+ {magic; image_base}
+
+ type section =
+ {
+ name: string;
+ virtual_size: int;
+ virtual_address: int64;
+ size_of_raw_data: int;
+ pointer_to_raw_data: int64;
+ }
+
+ let section_header_size = 40
+
+ let read_sections d
+ {e_lfanew; number_of_sections; size_of_optional_header; _} =
+ let buf =
+ load_bytes d
+ Int64.(add e_lfanew (of_int (header_size + size_of_optional_header)))
+ (number_of_sections * section_header_size)
+ in
+ let mk i =
+ let base = i * section_header_size in
+ let name = name_at ~max_len:8 buf (base + 0) in
+ let virtual_size = get_uint "virtual_size" d buf (base + 8) in
+ let virtual_address = uint64_of_uint32 (get_uint32 d buf (base + 12)) in
+ let size_of_raw_data = get_uint "size_of_raw_data" d buf (base + 16) in
+ let pointer_to_raw_data =
+ uint64_of_uint32 (get_uint32 d buf (base + 20)) in
+ {name; virtual_size; virtual_address;
+ size_of_raw_data; pointer_to_raw_data}
+ in
+ Array.init number_of_sections mk
+
+ type symbol =
+ {
+ name: string;
+ address: int64;
+ }
+
+ let load_section_body d {size_of_raw_data; pointer_to_raw_data; _} =
+ load_bytes d pointer_to_raw_data size_of_raw_data
+
+ let find_section sections sectname =
+ array_find (function ({name; _} : section) -> name = sectname) sections
+
+ (* We extract the list of exported symbols as encoded by flexlink, see
+ https://github.com/alainfrisch/flexdll/blob/bd636def70d941674275b2f4b6c13a34ba23f9c9/reloc.ml
+ #L500-L525 *)
+
+ let read_symbols d {image_base; _} sections =
+ match find_section sections ".exptbl" with
+ | None -> [| |]
+ | Some ({virtual_address; _} as exptbl) ->
+ let buf = load_section_body d exptbl in
+ let numexports =
+ uint64_to_int "numexports" (get_word d buf 0)
+ in
+ let word_size = word_size d in
+ let mk i =
+ let address = get_word d buf (word_size * (2 * i + 1)) in
+ let nameoff = get_word d buf (word_size * (2 * i + 2)) in
+ let name =
+ let off = Int64.(sub nameoff (add virtual_address image_base)) in
+ name_at buf (uint64_to_int "exptbl name offset" off)
+ in
+ {name; address}
+ in
+ Array.init numexports mk
+
+ let symbol_offset {image_base; _} sections symbols =
+ match find_section sections ".data" with
+ | None -> Fun.const None
+ | Some {virtual_address; pointer_to_raw_data; _} ->
+ fun symname ->
+ begin match
+ array_find (function {name; _} -> name = symname) symbols
+ with
+ | None -> None
+ | Some {address; _} ->
+ Some Int64.(add pointer_to_raw_data
+ (sub address (add virtual_address image_base)))
+ end
+
+ let defines_symbol symbols symname =
+ Array.exists (fun {name; _} -> name = symname) symbols
+
+ type machine_type =
+ | IMAGE_FILE_MACHINE_ARM
+ | IMAGE_FILE_MACHINE_ARM64
+ | IMAGE_FILE_MACHINE_AMD64
+ | IMAGE_FILE_MACHINE_I386
+
+ let read ic =
+ let e_lfanew =
+ seek_in ic 0x3c;
+ let buf = really_input_bytes ic 4 in
+ uint64_of_uint32 (Bytes.get_int32_le buf 0)
+ in
+ LargeFile.seek_in ic e_lfanew;
+ let buf = really_input_bytes ic header_size in
+ let magic = Bytes.sub_string buf 0 4 in
+ if magic <> "PE\000\000" then raise (Error (Unrecognized magic));
+ let machine =
+ match Bytes.get_uint16_le buf 4 with
+ | 0x1c0 -> IMAGE_FILE_MACHINE_ARM
+ | 0xaa64 -> IMAGE_FILE_MACHINE_ARM64
+ | 0x8664 -> IMAGE_FILE_MACHINE_AMD64
+ | 0x14c -> IMAGE_FILE_MACHINE_I386
+ | n -> raise (Error (Unsupported ("MACHINETYPE", Int64.of_int n)))
+ in
+ let bitness =
+ match machine with
+ | IMAGE_FILE_MACHINE_AMD64
+ | IMAGE_FILE_MACHINE_ARM64 -> B64
+ | IMAGE_FILE_MACHINE_I386
+ | IMAGE_FILE_MACHINE_ARM -> B32
+ in
+ let d = {ic; endianness = LE; bitness} in
+ let header = read_header e_lfanew d buf in
+ let opt_header = read_optional_header d header in
+ let sections = read_sections d header in
+ let symbols = read_symbols d opt_header sections in
+ let symbol_offset = symbol_offset opt_header sections symbols in
+ let defines_symbol = defines_symbol symbols in
+ {symbol_offset; defines_symbol}
+end
+
+let read ic =
+ seek_in ic 0;
+ let magic = really_input_string ic 4 in
+ match magic.[0], magic.[1], magic.[2], magic.[3] with
+ | '\x7F', 'E', 'L', 'F' ->
+ ELF.read ic
+ | '\xFE', '\xED', '\xFA', '\xCE'
+ | '\xCE', '\xFA', '\xED', '\xFE'
+ | '\xFE', '\xED', '\xFA', '\xCF'
+ | '\xCF', '\xFA', '\xED', '\xFE' ->
+ Mach_O.read ic
+ | 'M', 'Z', _, _ ->
+ FlexDLL.read ic
+ | _ ->
+ raise (Error (Unrecognized magic))
+
+let with_open_in fn f =
+ let ic = open_in_bin fn in
+ Fun.protect ~finally:(fun () -> close_in_noerr ic) (fun () -> f ic)
+
+let read filename =
+ match with_open_in filename read with
+ | t -> Ok t
+ | exception End_of_file ->
+ Result.Error Truncated_file
+ | exception Error err ->
+ Result.Error err
+
+let defines_symbol {defines_symbol; _} symname =
+ defines_symbol symname
+
+let symbol_offset {symbol_offset; _} symname =
+ symbol_offset symname
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Nicolas Ojeda Bar, LexiFi *)
+(* *)
+(* Copyright 2020 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+type error =
+ | Truncated_file
+ | Unrecognized of string
+ | Unsupported of string * int64
+ | Out_of_range of string
+
+val error_to_string: error -> string
+
+type t
+
+val read: string -> (t, error) Result.t
+
+val defines_symbol: t -> string -> bool
+
+val symbol_offset: t -> string -> int64 option
then display_msvc_output file name;
exit
-let macos_create_empty_archive ~quoted_archive =
- let result =
- command (Printf.sprintf "%s rc %s /dev/null" Config.ar quoted_archive)
- in
- if result <> 0 then result
- else
- let result =
- command (Printf.sprintf "%s %s 2> /dev/null" Config.ranlib quoted_archive)
- in
- if result <> 0 then result
- else
- command (Printf.sprintf "%s d %s /dev/null" Config.ar quoted_archive)
-
let create_archive archive file_list =
Misc.remove_file archive;
let quoted_archive = Filename.quote archive in
- match Config.ccomp_type with
- "msvc" ->
- command(Printf.sprintf "link /lib /nologo /out:%s %s"
- quoted_archive (quote_files file_list))
- | _ ->
- assert(String.length Config.ar > 0);
- let is_macosx =
- match Config.system with
- | "macosx" -> true
- | _ -> false
- in
- if is_macosx && file_list = [] then (* PR#6550 *)
- macos_create_empty_archive ~quoted_archive
- else
+ if file_list = [] then
+ 0 (* Don't call the archiver: #6550/#1094/#9011 *)
+ else
+ match Config.ccomp_type with
+ "msvc" ->
+ command(Printf.sprintf "link /lib /nologo /out:%s %s"
+ quoted_archive (quote_files file_list))
+ | _ ->
+ assert(String.length Config.ar > 0);
let r1 =
command(Printf.sprintf "%s rc %s %s"
Config.ar quoted_archive (quote_files file_list)) in
in
command cmd
)
+
+let linker_is_flexlink =
+ (* Config.mkexe, Config.mkdll and Config.mkmaindll are all flexlink
+ invocations for the native Windows ports and for Cygwin, if shared library
+ support is enabled. *)
+ Sys.win32 || Config.supports_shared_libraries && Sys.cygwin
| Partial
val call_linker: link_mode -> string -> string list -> string -> int
+
+val linker_is_flexlink : bool
let unboxed_types = ref false
+(* This is used by the -save-ir-after option. *)
+module Compiler_ir = struct
+ type t = Linear
+
+ let all = [
+ Linear;
+ ]
+
+ let extension t =
+ let ext =
+ match t with
+ | Linear -> "linear"
+ in
+ ".cmir-" ^ ext
+
+ (** [extract_extension_with_pass filename] returns the IR whose extension
+ is a prefix of the extension of [filename], and the suffix,
+ which can be used to distinguish different passes on the same IR.
+ For example, [extract_extension_with_pass "foo.cmir-linear123"]
+ returns [Some (Linear, "123")]. *)
+ let extract_extension_with_pass filename =
+ let ext = Filename.extension filename in
+ let ext_len = String.length ext in
+ if ext_len <= 0 then None
+ else begin
+ let is_prefix ir =
+ let s = extension ir in
+ let s_len = String.length s in
+ s_len <= ext_len && s = String.sub ext 0 s_len
+ in
+ let drop_prefix ir =
+ let s = extension ir in
+ let s_len = String.length s in
+ String.sub ext s_len (ext_len - s_len)
+ in
+ let ir = List.find_opt is_prefix all in
+ match ir with
+ | None -> None
+ | Some ir -> Some (ir, drop_prefix ir)
+ end
+end
+
(* This is used by the -stop-after option. *)
module Compiler_pass = struct
(* If you add a new pass, the following must be updated:
- the manpages in man/ocaml{c,opt}.m
- the manual manual/manual/cmds/unified-options.etex
*)
- type t = Parsing | Typing | Scheduling
+ type t = Parsing | Typing | Scheduling | Emit
let to_string = function
| Parsing -> "parsing"
| Typing -> "typing"
| Scheduling -> "scheduling"
+ | Emit -> "emit"
let of_string = function
| "parsing" -> Some Parsing
| "typing" -> Some Typing
| "scheduling" -> Some Scheduling
+ | "emit" -> Some Emit
| _ -> None
let rank = function
| Parsing -> 0
| Typing -> 1
| Scheduling -> 50
+ | Emit -> 60
let passes = [
Parsing;
Typing;
Scheduling;
+ Emit;
]
let is_compilation_pass _ = true
let is_native_only = function
| Scheduling -> true
+ | Emit -> true
| _ -> false
let enabled is_native t = not (is_native_only t) || is_native
+ let can_save_ir_after = function
+ | Scheduling -> true
+ | _ -> false
- let available_pass_names ~native =
+ let available_pass_names ~filter ~native =
passes
|> List.filter (enabled native)
+ |> List.filter filter
|> List.map to_string
+
+ let compare a b =
+ compare (rank a) (rank b)
+
+ let to_output_filename t ~prefix =
+ match t with
+ | Scheduling -> prefix ^ Compiler_ir.(extension Linear)
+ | _ -> Misc.fatal_error "Not supported"
+
+ let of_input_filename name =
+ match Compiler_ir.extract_extension_with_pass name with
+ | Some (Linear, _) -> Some Emit
+ | None -> None
end
let stop_after = ref None (* -stop-after *)
| None -> false
| Some stop -> Compiler_pass.rank stop <= Compiler_pass.rank pass
+let save_ir_after = ref []
+
+let should_save_ir_after pass =
+ List.mem pass !save_ir_after
+
+let set_save_ir_after pass enabled =
+ let other_passes = List.filter ((<>) pass) !save_ir_after in
+ let new_passes =
+ if enabled then
+ pass :: other_passes
+ else
+ other_passes
+ in
+ save_ir_after := new_passes
+
module String = Misc.Stdlib.String
let arg_spec = ref []
(* This function is almost the same as [Arg.parse_expand], except
that [Arg.parse_expand] could not be used because it does not take a
reference for [arg_spec].*)
-let parse_arguments f msg =
+let parse_arguments argv f msg =
try
- let argv = ref Sys.argv in
- let current = ref (!Arg.current) in
+ let argv = ref argv in
+ let current = ref 0 in
Arg.parse_and_expand_argv_dynamic current argv arg_spec f msg
with
| Arg.Bad msg -> Printf.eprintf "%s" msg; exit 2
val insn_sched_default : bool
module Compiler_pass : sig
- type t = Parsing | Typing | Scheduling
+ type t = Parsing | Typing | Scheduling | Emit
val of_string : string -> t option
val to_string : t -> string
val is_compilation_pass : t -> bool
- val available_pass_names : native:bool -> string list
+ val available_pass_names : filter:(t -> bool) -> native:bool -> string list
+ val can_save_ir_after : t -> bool
+ val compare : t -> t -> int
+ val to_output_filename: t -> prefix:string -> string
+ val of_input_filename: string -> t option
end
val stop_after : Compiler_pass.t option ref
val should_stop_after : Compiler_pass.t -> bool
+val set_save_ir_after : Compiler_pass.t -> bool -> unit
+val should_save_ir_after : Compiler_pass.t -> bool
val arg_spec : (string * Arg.spec * string) list ref
added. *)
val add_arguments : string -> (string * Arg.spec * string) list -> unit
-(* [parse_arguments anon_arg usage] will parse the arguments, using
+(* [parse_arguments argv anon_arg usage] will parse the arguments, using
the arguments provided in [Clflags.arg_spec].
*)
-val parse_arguments : Arg.anon_fun -> string -> unit
+val parse_arguments : string array -> Arg.anon_fun -> string -> unit
(* [print_arguments usage] print the standard usage message *)
val print_arguments : string -> unit
val cmt_magic_number: string
(** Magic number for compiled interface files *)
+val linear_magic_number: string
+(** Magic number for Linear internal representation files *)
+
val max_tag: int
(** Biggest tag that can be stored in the header of a regular block. *)
val ext_dll: string
(** Extension for dynamically-loaded libraries, e.g. [.so] under Unix.*)
+val ext_exe: string
+(** Extension for executable programs, e.g. [.exe] under Windows.
+
+ @since 4.12.0 *)
+
val default_executable_name: string
(** Name of executable produced by linking if none is given with -o,
e.g. [a.out] under Unix. *)
val with_flambda_invariants : bool
(** Whether the invariants checks for flambda are enabled *)
-val spacetime : bool
-(** Whether the compiler was configured for Spacetime profiling *)
-
-val enable_call_counts : bool
-(** Whether call counts are to be available when Spacetime profiling *)
-
val profinfo : bool
(** Whether the compiler was configured for profiling *)
(** How many bits are to be used in values' headers for profiling
information *)
-val libunwind_available : bool
-(** Whether the libunwind library is available on the target *)
-
-val libunwind_link_flags : string
-(** Linker flags to use libunwind *)
-
val safe_string: bool
(** Whether the compiler was configured with -force-safe-string;
in that case, the -unsafe-string compile-time option is unavailable
val config_var : string -> string option
(** the configuration value of a variable, if it exists *)
+
+(**/**)
+
+val merlin : bool
+
+(**/**)
let c = flexlink.[i] in
if c = '/' then '\\' else c in
(String.init (String.length flexlink) f) ^ " %%FLEXLINK_FLAGS%%" in
- flexlink,
+ flexlink ^ "%%FLEXLINK_DLL_LDFLAGS%%",
flexlink ^ " -exe%%FLEXLINK_LDFLAGS%%",
- flexlink ^ " -maindll"
+ flexlink ^ " -maindll%%FLEXLINK_DLL_LDFLAGS%%"
with Not_found ->
"%%MKDLL%%", "%%MKEXE%%", "%%MKMAINDLL%%"
else
let function_sections = %%FUNCTION_SECTIONS%%
let afl_instrument = %%AFL_INSTRUMENT%%
-let exec_magic_number = "Caml1999X028"
+let exec_magic_number = "Caml1999X029"
(* exec_magic_number is duplicated in runtime/caml/exec.h *)
-and cmi_magic_number = "Caml1999I028"
-and cmo_magic_number = "Caml1999O028"
-and cma_magic_number = "Caml1999A028"
+and cmi_magic_number = "Caml1999I029"
+and cmo_magic_number = "Caml1999O029"
+and cma_magic_number = "Caml1999A029"
and cmx_magic_number =
if flambda then
- "Caml1999y028"
+ "Caml1999y029"
else
- "Caml1999Y028"
+ "Caml1999Y029"
and cmxa_magic_number =
if flambda then
- "Caml1999z028"
+ "Caml1999z029"
else
- "Caml1999Z028"
-and ast_impl_magic_number = "Caml1999M028"
-and ast_intf_magic_number = "Caml1999N028"
-and cmxs_magic_number = "Caml1999D028"
-and cmt_magic_number = "Caml1999T028"
+ "Caml1999Z029"
+and ast_impl_magic_number = "Caml1999M029"
+and ast_intf_magic_number = "Caml1999N029"
+and cmxs_magic_number = "Caml1999D029"
+and cmt_magic_number = "Caml1999T029"
+and linear_magic_number = "Caml1999L029"
let interface_suffix = ref ".mli"
let asm = "%%ASM%%"
let asm_cfi_supported = %%ASM_CFI_SUPPORTED%%
let with_frame_pointers = %%WITH_FRAME_POINTERS%%
-let spacetime = %%WITH_SPACETIME%%
-let enable_call_counts = %%ENABLE_CALL_COUNTS%%
-let libunwind_available = %%LIBUNWIND_AVAILABLE%%
-let libunwind_link_flags = "%%LIBUNWIND_LINK_FLAGS%%"
let profinfo = %%WITH_PROFINFO%%
let profinfo_width = %%PROFINFO_WIDTH%%
p "host" host;
p "target" target;
p_bool "flambda" flambda;
- p_bool "spacetime" spacetime;
p_bool "safe_string" safe_string;
p_bool "default_safe_string" default_safe_string;
p_bool "flat_float_array" flat_float_array;
p "ast_intf_magic_number" ast_intf_magic_number;
p "cmxs_magic_number" cmxs_magic_number;
p "cmt_magic_number" cmt_magic_number;
+ p "linear_magic_number" linear_magic_number;
]
let print_config_value oc = function
| Bool b -> string_of_bool b
in
Some s
+
+let merlin = false
(mode fallback)
(deps (:mk Makefile)
../Makefile.config
+ ; for now the utils Makefile does not use build_config
config.mlp)
(action (system "make -f %{mk} %{targets}")))
(* *)
(**************************************************************************)
+open Local_store
+
module SMap = Misc.Stdlib.String.Map
(* Mapping from basenames to full filenames *)
type registry = string SMap.t ref
-let files : registry = ref SMap.empty
-let files_uncap : registry = ref SMap.empty
+let files : registry = s_ref SMap.empty
+let files_uncap : registry = s_ref SMap.empty
module Dir = struct
type t = {
{ path; files = Array.to_list (readdir_compat path) }
end
-let dirs = ref []
+let dirs = s_ref []
let reset () =
+ assert (not Config.merlin || Local_store.is_bound ());
files := SMap.empty;
files_uncap := SMap.empty;
dirs := []
-let get () = !dirs
-let get_paths () = List.map Dir.path !dirs
+let get () = List.rev !dirs
+let get_paths () = List.rev_map Dir.path !dirs
+
+let add_to_maps fn basenames files files_uncap =
+ List.fold_left (fun (files, files_uncap) base ->
+ let fn = fn base in
+ SMap.add base fn files,
+ SMap.add (String.uncapitalize_ascii base) fn files_uncap
+ ) (files, files_uncap) basenames
+(* Optimized version of [add] below, for use in [init] and [remove_dir]: since
+ we are starting from an empty cache, we can avoid checking whether a unit
+ name already exists in the cache simply by adding entries in reverse
+ order. *)
let add dir =
- let add_file base =
- let fn = Filename.concat dir.Dir.path base in
- files := SMap.add base fn !files;
- files_uncap := SMap.add (String.uncapitalize_ascii base) fn !files_uncap;
+ assert (not Config.merlin || Local_store.is_bound ());
+ let new_files, new_files_uncap =
+ add_to_maps (Filename.concat dir.Dir.path)
+ dir.Dir.files !files !files_uncap
in
- List.iter add_file dir.Dir.files;
- dirs := dir :: !dirs
+ files := new_files;
+ files_uncap := new_files_uncap
+
+let init l =
+ reset ();
+ dirs := List.rev_map Dir.create l;
+ List.iter add !dirs
let remove_dir dir =
+ assert (not Config.merlin || Local_store.is_bound ());
let new_dirs = List.filter (fun d -> Dir.path d <> dir) !dirs in
- if new_dirs <> !dirs then begin
+ if List.compare_lengths new_dirs !dirs <> 0 then begin
reset ();
- List.iter add (List.rev new_dirs)
+ List.iter add new_dirs;
+ dirs := new_dirs
end
-let add_dir dir = add (Dir.create dir)
+(* General purpose version of function to add a new entry to load path: We only
+ add a basename to the cache if it is not already present in the cache, in
+ order to enforce left-to-right precedence. *)
+let add dir =
+ assert (not Config.merlin || Local_store.is_bound ());
+ let new_files, new_files_uncap =
+ add_to_maps (Filename.concat dir.Dir.path) dir.Dir.files
+ SMap.empty SMap.empty
+ in
+ let first _ fn _ = Some fn in
+ files := SMap.union first !files new_files;
+ files_uncap := SMap.union first !files_uncap new_files_uncap;
+ dirs := dir :: !dirs
-let init l =
- reset ();
- List.iter add_dir (List.rev l)
+let add_dir dir = add (Dir.create dir)
let is_basename fn = Filename.basename fn = fn
let find fn =
+ assert (not Config.merlin || Local_store.is_bound ());
if is_basename fn then
SMap.find fn !files
else
Misc.find_in_path (get_paths ()) fn
let find_uncap fn =
+ assert (not Config.merlin || Local_store.is_bound ());
if is_basename fn then
SMap.find (String.uncapitalize_ascii fn) !files_uncap
else
(** [init l] is the same as [reset (); List.iter add_dir (List.rev l)] *)
val get_paths : unit -> string list
-(** Return the list of directories passed to [add_dir] so far, in
- reverse order. *)
+(** Return the list of directories passed to [add_dir] so far. *)
val find : string -> string
(** Locate a file in the load path. Raise [Not_found] if the file
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Frederic Bour, Tarides *)
+(* Thomas Refis, Tarides *)
+(* *)
+(* Copyright 2020 Tarides *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+type ref_and_reset =
+ | Table : { ref: 'a ref; init: unit -> 'a } -> ref_and_reset
+ | Ref : { ref: 'a ref; mutable snapshot: 'a } -> ref_and_reset
+
+type bindings = {
+ mutable refs: ref_and_reset list;
+ mutable frozen : bool;
+ mutable is_bound: bool;
+}
+
+let global_bindings =
+ { refs = []; is_bound = false; frozen = false }
+
+let is_bound () = global_bindings.is_bound
+
+let reset () =
+ assert (is_bound ());
+ List.iter (function
+ | Table { ref; init } -> ref := init ()
+ | Ref { ref; snapshot } -> ref := snapshot
+ ) global_bindings.refs
+
+let s_table create size =
+ let init () = create size in
+ let ref = ref (init ()) in
+ assert (not global_bindings.frozen);
+ global_bindings.refs <- (Table { ref; init }) :: global_bindings.refs;
+ ref
+
+let s_ref k =
+ let ref = ref k in
+ assert (not global_bindings.frozen);
+ global_bindings.refs <-
+ (Ref { ref; snapshot = k }) :: global_bindings.refs;
+ ref
+
+type slot = Slot : { ref : 'a ref; mutable value : 'a } -> slot
+type store = slot list
+
+let fresh () =
+ let slots =
+ List.map (function
+ | Table { ref; init } -> Slot {ref; value = init ()}
+ | Ref r ->
+ if not global_bindings.frozen then r.snapshot <- !(r.ref);
+ Slot { ref = r.ref; value = r.snapshot }
+ ) global_bindings.refs
+ in
+ global_bindings.frozen <- true;
+ slots
+
+let with_store slots f =
+ assert (not global_bindings.is_bound);
+ global_bindings.is_bound <- true;
+ List.iter (fun (Slot {ref;value}) -> ref := value) slots;
+ Fun.protect f ~finally:(fun () ->
+ List.iter (fun (Slot s) -> s.value <- !(s.ref)) slots;
+ global_bindings.is_bound <- false;
+ )
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Frederic Bour, Tarides *)
+(* Thomas Refis, Tarides *)
+(* *)
+(* Copyright 2020 Tarides *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(** This module provides some facilities for creating references (and hash
+ tables) which can easily be snapshoted and restored to an arbitrary version.
+
+ It is used throughout the frontend (read: typechecker), to register all
+ (well, hopefully) the global state. Thus making it easy for tools like
+ Merlin to go back and forth typechecking different files. *)
+
+(** {1 Creators} *)
+
+val s_ref : 'a -> 'a ref
+(** Similar to {!ref}, except the allocated reference is registered into the
+ store. *)
+
+val s_table : ('a -> 'b) -> 'a -> 'b ref
+(** Used to register hash tables. Those also need to be placed into refs to be
+ easily swapped out, but one can't just "snapshot" the initial value to
+ create fresh instances, so instead an initializer is required.
+
+ Use it like this:
+ {[
+ let my_table = s_table Hashtbl.create 42
+ ]}
+*)
+
+(** {1 State management}
+
+ Note: all the following functions are currently unused inside the compiler
+ codebase. Merlin is their only user at the moment. *)
+
+type store
+
+val fresh : unit -> store
+(** Returns a fresh instance of the store.
+
+ The first time this function is called, it snapshots the value of all the
+ registered references, later calls to [fresh] will return instances
+ initialized to those values. *)
+
+val with_store : store -> (unit -> 'a) -> 'a
+(** [with_scope s f] resets all the registered references to the value they have
+ in [s] for the run of [f].
+ If [f] updates any of the registered refs, [s] is updated to remember those
+ changes. *)
+
+val reset : unit -> unit
+(** Resets all the references to the initial snapshot (i.e. to the same values
+ that new instances start with). *)
+
+val is_bound : unit -> bool
+(** Returns [true] when a scope is active (i.e. when called from the callback
+ passed to {!with_scope}), [false] otherwise. *)
Printexc.raise_with_backtrace always_exn always_bt
end
+let reraise_preserving_backtrace e f =
+ let bt = Printexc.get_raw_backtrace () in
+ f ();
+ Printexc.raise_with_backtrace e bt
+
type ref_and_value = R : 'a ref * 'a -> ref_and_value
let protect_refs =
| (hd1 :: tl1, hd2 :: tl2) -> eq hd1 hd2 && equal eq tl1 tl2
| (_, _) -> false
- let rec find_map f = function
- | x :: xs ->
- begin match f x with
- | None -> find_map f xs
- | Some _ as y -> y
- end
- | [] -> None
-
let map2_prefix f l1 l2 =
let rec aux acc l1 l2 =
match l1, l2 with
for easier debugging.
*)
+val reraise_preserving_backtrace : exn -> (unit -> unit) -> 'a
+(** [reraise_preserving_backtrace e f] is (f (); raise e) except that the
+ current backtrace is preserved, even if [f] uses exceptions internally. *)
+
val map_end: ('a -> 'b) -> 'a list -> 'b list -> 'b list
(* [map_end f l t] is [map f l @ t], just more efficient. *)
There is no constraint on the relative lengths of the lists. *)
val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
- (** Returns [true] iff the given lists have the same length and content
- with respect to the given equality function. *)
-
- val find_map : ('a -> 'b option) -> 'a t -> 'b option
- (** [find_map f l] returns the first evaluation of [f] that returns [Some],
- or returns None if there is no such element. *)
+ (** Returns [true] if and only if the given lists have the same length and
+ content with respect to the given equality function. *)
val some_if_all_elements_are_some : 'a option t -> 'a t option
(** If all elements of the given list are [Some _] then [Some xs]
-> 'a list
-> of_:'a list
-> bool
- (** Returns [true] iff the given list, with respect to the given equality
- function on list members, is a prefix of the list [of_]. *)
+ (** Returns [true] if and only if the given list, with respect to the given
+ equality function on list members, is a prefix of the list [of_]. *)
type 'a longest_common_prefix_result = private {
longest_common_prefix : 'a list;
| Comment_not_end (* 2 *)
(*| Deprecated --> alert "deprecated" *) (* 3 *)
| Fragile_match of string (* 4 *)
- | Partial_application (* 5 *)
+ | Ignored_partial_application (* 5 *)
| Labels_omitted of string list (* 6 *)
| Method_override of string list (* 7 *)
| Partial_match of string (* 8 *)
- | Non_closed_record_pattern of string (* 9 *)
- | Statement_type (* 10 *)
- | Unused_match (* 11 *)
- | Unused_pat (* 12 *)
+ | Missing_record_field_pattern of string (* 9 *)
+ | Non_unit_statement (* 10 *)
+ | Redundant_case (* 11 *)
+ | Redundant_subpat (* 12 *)
| Instance_variable_override of string list (* 13 *)
| Illegal_backslash (* 14 *)
| Implicit_public_methods of string list (* 15 *)
| Unerasable_optional_argument (* 16 *)
| Undeclared_virtual_method of string (* 17 *)
| Not_principal of string (* 18 *)
- | Without_principality of string (* 19 *)
- | Unused_argument (* 20 *)
+ | Non_principal_labels of string (* 19 *)
+ | Ignored_extra_argument (* 20 *)
| Nonreturning_statement (* 21 *)
| Preprocessor of string (* 22 *)
| Useless_record_with (* 23 *)
| Wildcard_arg_to_constant_constr (* 28 *)
| Eol_in_string (* 29 *)
| Duplicate_definitions of string * string * string * string (*30 *)
- | Multiple_definition of string * string * string (* 31 *)
+ | Module_linked_twice of string * string * string (* 31 *)
| Unused_value_declaration of string (* 32 *)
| Unused_open of string (* 33 *)
| Unused_type_declaration of string (* 34 *)
| Attribute_payload of string * string (* 47 *)
| Eliminated_optional_arguments of string list (* 48 *)
| No_cmi_file of string * string option (* 49 *)
- | Bad_docstring of bool (* 50 *)
- | Expect_tailcall (* 51 *)
+ | Unexpected_docstring of bool (* 50 *)
+ | Wrong_tailcall_expectation of bool (* 51 *)
| Fragile_literal_pattern (* 52 *)
| Misplaced_attribute of string (* 53 *)
| Duplicated_attribute of string (* 54 *)
| Inlining_impossible of string (* 55 *)
| Unreachable_case (* 56 *)
- | Ambiguous_pattern of string list (* 57 *)
+ | Ambiguous_var_in_pattern_guard of string list (* 57 *)
| No_cmx_file of string (* 58 *)
- | Assignment_to_non_mutable_value (* 59 *)
+ | Flambda_assignment_to_non_mutable_value (* 59 *)
| Unused_module of string (* 60 *)
| Unboxable_type_in_prim_decl of string (* 61 *)
| Constraint_on_gadt (* 62 *)
| Erroneous_printed_signature of string (* 63 *)
- | Unsafe_without_parsing (* 64 *)
+ | Unsafe_array_syntax_without_parsing (* 64 *)
| Redefining_unit of string (* 65 *)
| Unused_open_bang of string (* 66 *)
| Unused_functor_parameter of string (* 67 *)
+ | Match_on_mutable_state_prevent_uncurry (* 68 *)
;;
(* If you remove a warning, leave a hole in the numbering. NEVER change
type alert = {kind:string; message:string; def:loc; use:loc}
-
let number = function
| Comment_start -> 1
| Comment_not_end -> 2
| Fragile_match _ -> 4
- | Partial_application -> 5
+ | Ignored_partial_application -> 5
| Labels_omitted _ -> 6
| Method_override _ -> 7
| Partial_match _ -> 8
- | Non_closed_record_pattern _ -> 9
- | Statement_type -> 10
- | Unused_match -> 11
- | Unused_pat -> 12
+ | Missing_record_field_pattern _ -> 9
+ | Non_unit_statement -> 10
+ | Redundant_case -> 11
+ | Redundant_subpat -> 12
| Instance_variable_override _ -> 13
| Illegal_backslash -> 14
| Implicit_public_methods _ -> 15
| Unerasable_optional_argument -> 16
| Undeclared_virtual_method _ -> 17
| Not_principal _ -> 18
- | Without_principality _ -> 19
- | Unused_argument -> 20
+ | Non_principal_labels _ -> 19
+ | Ignored_extra_argument -> 20
| Nonreturning_statement -> 21
| Preprocessor _ -> 22
| Useless_record_with -> 23
| Wildcard_arg_to_constant_constr -> 28
| Eol_in_string -> 29
| Duplicate_definitions _ -> 30
- | Multiple_definition _ -> 31
+ | Module_linked_twice _ -> 31
| Unused_value_declaration _ -> 32
| Unused_open _ -> 33
| Unused_type_declaration _ -> 34
| Attribute_payload _ -> 47
| Eliminated_optional_arguments _ -> 48
| No_cmi_file _ -> 49
- | Bad_docstring _ -> 50
- | Expect_tailcall -> 51
+ | Unexpected_docstring _ -> 50
+ | Wrong_tailcall_expectation _ -> 51
| Fragile_literal_pattern -> 52
| Misplaced_attribute _ -> 53
| Duplicated_attribute _ -> 54
| Inlining_impossible _ -> 55
| Unreachable_case -> 56
- | Ambiguous_pattern _ -> 57
+ | Ambiguous_var_in_pattern_guard _ -> 57
| No_cmx_file _ -> 58
- | Assignment_to_non_mutable_value -> 59
+ | Flambda_assignment_to_non_mutable_value -> 59
| Unused_module _ -> 60
| Unboxable_type_in_prim_decl _ -> 61
| Constraint_on_gadt -> 62
| Erroneous_printed_signature _ -> 63
- | Unsafe_without_parsing -> 64
+ | Unsafe_array_syntax_without_parsing -> 64
| Redefining_unit _ -> 65
| Unused_open_bang _ -> 66
| Unused_functor_parameter _ -> 67
+ | Match_on_mutable_state_prevent_uncurry -> 68
+;;
+
+let last_warning_number = 68
;;
-let last_warning_number = 67
+(* 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. *)
+
+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,
+ "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"];
+ ]
+;;
+
+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
+ ) descriptions;
+ fun s -> Hashtbl.find_opt h s
;;
(* Must be the max number returned by the [number] function. *)
loop (i+1)
| _ -> error ()
in
- loop 0
+ match name_to_number s with
+ | Some n -> set n
+ | None ->
+ if s = "" then loop 0
+ else begin
+ let rest = String.sub s 1 (String.length s - 1) in
+ match s.[0], name_to_number rest with
+ | '+', Some n -> set n
+ | '-', Some n -> clear n
+ | '@', Some n -> set_all n
+ | _ -> loop 0
+ end
;;
let parse_options errflag s =
current := {(!current) with error; active}
(* If you change these, don't forget to change them in man/ocamlc.m *)
-let defaults_w = "+a-4-6-7-9-27-29-30-32..42-44-45-48-50-60-66-67";;
+let defaults_w = "+a-4-6-7-9-27-29-30-32..42-44-45-48-50-60-66-67-68";;
let defaults_warn_error = "-a+31";;
let () = parse_options false defaults_w;;
| Fragile_match s ->
"this pattern-matching is fragile.\n\
It will remain exhaustive when constructors are added to type " ^ s ^ "."
- | Partial_application ->
+ | Ignored_partial_application ->
"this function application is partial,\n\
maybe some arguments are missing."
| Labels_omitted [] -> assert false
| Partial_match s ->
"this pattern-matching is not exhaustive.\n\
Here is an example of a case that is not matched:\n" ^ s
- | Non_closed_record_pattern s ->
+ | Missing_record_field_pattern s ->
"the following labels are not bound in this record pattern:\n" ^ s ^
"\nEither bind these labels explicitly or add '; _' to the pattern."
- | Statement_type ->
+ | Non_unit_statement ->
"this expression should have type unit."
- | Unused_match -> "this match case is unused."
- | Unused_pat -> "this sub-pattern is unused."
+ | 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.)"
| Unerasable_optional_argument -> "this optional argument cannot be erased."
| Undeclared_virtual_method m -> "the virtual method "^m^" is not declared."
| Not_principal s -> s^" is not principal."
- | Without_principality s -> s^" without principality."
- | Unused_argument -> "this argument will not be used by the function."
+ | Non_principal_labels s -> s^" without principality."
+ | Ignored_extra_argument -> "this argument will not be used by the function."
| Nonreturning_statement ->
"this statement never returns (or has an unsound type.)"
| Preprocessor s -> s
| Duplicate_definitions (kind, cname, tc1, tc2) ->
Printf.sprintf "the %s %s is defined in both types %s and %s."
kind cname tc1 tc2
- | Multiple_definition(modname, file1, file2) ->
+ | Module_linked_twice(modname, file1, file2) ->
Printf.sprintf
"files %s and %s both define a module named %s"
file1 file2 modname
Printf.sprintf
"no valid cmi file was found in path for module %s. %s"
name msg
- | Bad_docstring unattached ->
+ | Unexpected_docstring unattached ->
if unattached then "unattached documentation comment (ignored)"
else "ambiguous documentation comment"
- | Expect_tailcall ->
- Printf.sprintf "expected tailcall"
+ | Wrong_tailcall_expectation b ->
+ Printf.sprintf "expected %s"
+ (if b then "tailcall" else "non-tailcall")
| Fragile_literal_pattern ->
Printf.sprintf
"Code should not depend on the actual values of\n\
attr_name
| Inlining_impossible reason ->
Printf.sprintf "Cannot inline: %s" reason
- | Ambiguous_pattern vars ->
+ | Ambiguous_var_in_pattern_guard vars ->
let msg =
let vars = List.sort String.compare vars in
match vars with
Printf.sprintf
"no cmx file was found in path for module %s, \
and its interface was not compiled with -opaque" name
- | Assignment_to_non_mutable_value ->
+ | Flambda_assignment_to_non_mutable_value ->
"A potential assignment to a non-mutable value was detected \n\
in this source file. Such assignments may generate incorrect code \n\
when using Flambda."
^ s
^ "\nBeware that this warning is purely informational and will not catch\n\
all instances of erroneous printed interface."
- | Unsafe_without_parsing ->
+ | Unsafe_array_syntax_without_parsing ->
"option -unsafe used with a preprocessor returning a syntax tree"
| Redefining_unit name ->
Printf.sprintf
which shadows the existing one.\n\
Hint: Did you mean 'type %s = unit'?" name
| Unused_functor_parameter s -> "unused functor parameter " ^ s ^ "."
+ | Match_on_mutable_state_prevent_uncurry ->
+ "This pattern depends on mutable state.\n\
+ It prevents the remaining arguments from being uncurried, which will \
+ cause additional closure allocations."
;;
let nerrors = ref 0;;
; sub_locs : (loc * string) list;
}
+let id_name w =
+ let n = number w in
+ match List.find_opt (fun (m, _, _) -> m = n) descriptions with
+ | Some (_, _, s :: _) ->
+ Printf.sprintf "%d [%s]" n s
+ | _ ->
+ string_of_int n
+
let report w =
match is_active w with
| false -> `Inactive
| true ->
if is_error w then incr nerrors;
`Active
- { id = string_of_int (number w);
+ { id = id_name w;
message = message w;
is_error = is_error w;
sub_locs = [];
end;
;;
-let descriptions =
- [
- 1, "Suspicious-looking start-of-comment mark.";
- 2, "Suspicious-looking end-of-comment mark.";
- 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.";
- 5, "Partially applied function: expression whose result has function\n\
- \ type and is ignored.";
- 6, "Label omitted in function application.";
- 7, "Method overridden.";
- 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\n\
- \ \"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, "Instance variable overridden.";
- 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 \"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\n\
- \ with \"let\" or \"as\", and doesn't start with an underscore (\"_\")\n\
- \ character.";
- 27, "Innocuous unused variable: unused variable that is not bound with\n\
- \ \"let\" nor \"as\", and doesn't start with an underscore (\"_\")\n\
- \ character.";
- 28, "Wildcard pattern given as argument to a constant constructor.";
- 29, "Unescaped end-of-line in a string constant (non-portable code).";
- 30, "Two labels or constructors of the same name are defined in two\n\
- \ 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 (compatibility warning).";
- 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, "Absent cmi file when looking up module alias.";
- 50, "Unexpected documentation comment.";
- 51, "Warning on non-tail calls if @tailcall present.";
- 52, "Fragile constant pattern.";
- 53, "Attribute cannot appear in this context.";
- 54, "Attribute used more than once on an expression.";
- 55, "Inlining impossible.";
- 56, "Unreachable case in a pattern-matching (based on type information).";
- 57, "Ambiguous or-pattern variables under guard.";
- 58, "Missing cmx file.";
- 59, "Assignment to non-mutable value.";
- 60, "Unused module declaration.";
- 61, "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.";
- ]
-;;
-
let help_warnings () =
- List.iter (fun (i, s) -> Printf.printf "%3i %s\n" i s) descriptions;
+ List.iter
+ (fun (i, s, names) ->
+ let name =
+ match names with
+ | s :: _ -> " [" ^ s ^ "]"
+ | [] -> ""
+ in
+ Printf.printf "%3i%s %s\n" i name s)
+ descriptions;
print_endline " A all warnings";
for i = Char.code 'b' to Char.code 'z' do
let c = Char.chr i in
| Comment_not_end (* 2 *)
(*| Deprecated --> alert "deprecated" *) (* 3 *)
| Fragile_match of string (* 4 *)
- | Partial_application (* 5 *)
+ | Ignored_partial_application (* 5 *)
| Labels_omitted of string list (* 6 *)
| Method_override of string list (* 7 *)
| Partial_match of string (* 8 *)
- | Non_closed_record_pattern of string (* 9 *)
- | Statement_type (* 10 *)
- | Unused_match (* 11 *)
- | Unused_pat (* 12 *)
+ | Missing_record_field_pattern of string (* 9 *)
+ | Non_unit_statement (* 10 *)
+ | Redundant_case (* 11 *)
+ | Redundant_subpat (* 12 *)
| Instance_variable_override of string list (* 13 *)
| Illegal_backslash (* 14 *)
| Implicit_public_methods of string list (* 15 *)
| Unerasable_optional_argument (* 16 *)
| Undeclared_virtual_method of string (* 17 *)
| Not_principal of string (* 18 *)
- | Without_principality of string (* 19 *)
- | Unused_argument (* 20 *)
+ | Non_principal_labels of string (* 19 *)
+ | Ignored_extra_argument (* 20 *)
| Nonreturning_statement (* 21 *)
| Preprocessor of string (* 22 *)
| Useless_record_with (* 23 *)
| Wildcard_arg_to_constant_constr (* 28 *)
| Eol_in_string (* 29 *)
| Duplicate_definitions of string * string * string * string (* 30 *)
- | Multiple_definition of string * string * string (* 31 *)
+ | Module_linked_twice of string * string * string (* 31 *)
| Unused_value_declaration of string (* 32 *)
| Unused_open of string (* 33 *)
| Unused_type_declaration of string (* 34 *)
| Attribute_payload of string * string (* 47 *)
| Eliminated_optional_arguments of string list (* 48 *)
| No_cmi_file of string * string option (* 49 *)
- | Bad_docstring of bool (* 50 *)
- | Expect_tailcall (* 51 *)
+ | Unexpected_docstring of bool (* 50 *)
+ | Wrong_tailcall_expectation of bool (* 51 *)
| Fragile_literal_pattern (* 52 *)
| Misplaced_attribute of string (* 53 *)
| Duplicated_attribute of string (* 54 *)
| Inlining_impossible of string (* 55 *)
| Unreachable_case (* 56 *)
- | Ambiguous_pattern of string list (* 57 *)
+ | Ambiguous_var_in_pattern_guard of string list (* 57 *)
| No_cmx_file of string (* 58 *)
- | Assignment_to_non_mutable_value (* 59 *)
+ | Flambda_assignment_to_non_mutable_value (* 59 *)
| Unused_module of string (* 60 *)
| Unboxable_type_in_prim_decl of string (* 61 *)
| Constraint_on_gadt (* 62 *)
| Erroneous_printed_signature of string (* 63 *)
- | Unsafe_without_parsing (* 64 *)
+ | Unsafe_array_syntax_without_parsing (* 64 *)
| Redefining_unit of string (* 65 *)
| Unused_open_bang of string (* 66 *)
| Unused_functor_parameter of string (* 67 *)
+ | Match_on_mutable_state_prevent_uncurry (* 68 *)
;;
type alert = {kind:string; message:string; def:loc; use:loc}
ROOTDIR = ..
--include $(ROOTDIR)/Makefile.config
--include $(ROOTDIR)/Makefile.common
+include $(ROOTDIR)/Makefile.common
OC_CPPFLAGS += -I$(ROOTDIR)/runtime
projects / ocaml.git / commitdiff